OpenCMISS-Iron Internal API Documentation
finite_elasticity_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE finite_elasticity_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE boundary_conditions_routines
50  USE comp_environment
51  USE constants
52  USE control_loop_routines
53  USE coordinate_routines
54  USE distributed_matrix_vector
55  USE domain_mappings
56  USE equations_routines
57  USE equations_mapping_routines
58  USE equations_matrices_routines
59  USE equations_set_constants
60  USE field_routines
61  USE field_io_routines
62  USE fluid_mechanics_io_routines
63  USE generated_mesh_routines
64  USE input_output
65  USE iso_varying_string
66  USE kinds
67  USE lapack
68  USE maths
69  USE matrix_vector
70  USE mesh_routines
71 #ifndef NOMPIMOD
72  USE mpi
73 #endif
74  USE problem_constants
75  USE solver_routines
76  USE strings
77  USE timer
78  USE types
79 
80 #include "macros.h"
81 
82  IMPLICIT NONE
83 
84 #ifdef NOMPIMOD
85 #include "mpif.h"
86 #endif
87 
88  PRIVATE
89 
90  !Module parameters
91 
96  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_pin_idx=1
97  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_pout_idx=2
98  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_lambda_idx=3
99  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_tsi_idx=4
100  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_rin_idx=5
101  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_rout_idx=6
102  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_c1_idx=7
103  INTEGER(INTG), PARAMETER :: finite_elasticity_analytic_cylinder_param_c2_idx=8
105 
106  !Module types
107 
108  !Module variables
109 
110  !Interfaces
111 
112  PUBLIC finite_elasticity_analytic_cylinder_param_pin_idx,finite_elasticity_analytic_cylinder_param_pout_idx, &
113  & finite_elasticity_analytic_cylinder_param_lambda_idx, finite_elasticity_analytic_cylinder_param_tsi_idx, &
114  & finite_elasticity_analytic_cylinder_param_rin_idx, finite_elasticity_analytic_cylinder_param_rout_idx, &
115  & finite_elasticity_analytic_cylinder_param_c1_idx, finite_elasticity_analytic_cylinder_param_c2_idx
116 
117  PUBLIC finiteelasticity_boundaryconditionsanalyticcalculate, &
118  & finiteelasticity_finiteelementresidualevaluate,finiteelasticity_finiteelementjacobianevaluate, &
119  & finite_elasticity_equations_set_setup,finiteelasticity_equationssetsolutionmethodset, &
120  & finiteelasticity_equationssetspecificationset,finiteelasticity_problemspecificationset,finite_elasticity_problem_setup, &
121  & finiteelasticity_contactproblemspecificationset,finiteelasticity_contactproblemsetup, &
122  & finite_elasticity_post_solve,finite_elasticity_post_solve_output_data, &
123  & finite_elasticity_pre_solve,finiteelasticity_controltimelooppreloop,finiteelasticity_controlloadincrementlooppostloop, &
124  & evaluate_chapelle_function, get_darcy_finite_elasticity_parameters, &
125  & finiteelasticity_gaussdeformationgradienttensor,finite_elasticity_load_increment_apply, &
126  & finiteelasticity_straincalculate, &
127  & finiteelasticity_finiteelementpreresidualevaluate,finiteelasticity_finiteelementpostresidualevaluate
128 
129  PUBLIC finiteelasticityequationsset_derivedvariablecalculate, &
130  & finiteelasticity_tensorinterpolatexi
131 
132 CONTAINS
133 
134  !
135  !================================================================================================================================
136  !
137 
139  SUBROUTINE finiteelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
140  !Argument variables
141  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
142  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
143  INTEGER(INTG), INTENT(OUT) :: ERR
144  TYPE(varying_string), INTENT(OUT) :: ERROR
145  !Local variables
146  INTEGER(INTG) :: node_idx,component_idx,deriv_idx,variable_idx,dim_idx,local_ny,variable_type
147  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,user_node,global_node,local_node
148  REAL(DP) :: X(3),DEFORMED_X(3),P
149  REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
150  TYPE(domain_type), POINTER :: DOMAIN,DOMAIN_PRESSURE
151  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES,DOMAIN_PRESSURE_NODES
152  TYPE(decomposition_type), POINTER :: DECOMPOSITION
153  TYPE(mesh_type), POINTER :: MESH
154  TYPE(generated_mesh_type), POINTER :: GENERATED_MESH
155  TYPE(domain_mapping_type), POINTER :: NODES_MAPPING
156  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
157  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
158  !BC stuff
159  INTEGER(INTG),ALLOCATABLE :: INNER_SURFACE_NODES(:),OUTER_SURFACE_NODES(:),TOP_SURFACE_NODES(:),BOTTOM_SURFACE_NODES(:)
160  INTEGER(INTG) :: INNER_NORMAL_XI,OUTER_NORMAL_XI,TOP_NORMAL_XI,BOTTOM_NORMAL_XI,MESH_COMPONENT
161  INTEGER(INTG) :: MY_COMPUTATIONAL_NODE_NUMBER, DOMAIN_NUMBER, MPI_IERROR
162  REAL(DP) :: PIN,POUT,LAMBDA,DEFORMED_Z
163  LOGICAL :: X_FIXED,Y_FIXED,NODE_EXISTS, X_OKAY,Y_OKAY
164  TYPE(varying_string) :: LOCAL_ERROR
165 
166  NULLIFY(geometric_parameters)
167 
168  enters("FiniteElasticity_BoundaryConditionsAnalyticCalculate",err,error,*999)
169 
170  my_computational_node_number=computational_node_number_get(err,error)
171 
172  IF(ASSOCIATED(equations_set)) THEN
173  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
174  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
175  IF(ASSOCIATED(dependent_field)) THEN
176  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
177  IF(ASSOCIATED(geometric_field)) THEN
178  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
179  !Get access to geometric coordinates
180  NULLIFY(geometric_variable)
181  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
182  mesh_component=geometric_variable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
183  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
184  & err,error,*999)
185  !Assign BC here - it's complicated so separate from analytic calculations
186  IF(ASSOCIATED(boundary_conditions)) THEN
187  decomposition=>dependent_field%DECOMPOSITION
188  IF(ASSOCIATED(decomposition)) THEN
189  mesh=>decomposition%MESH
190  IF(ASSOCIATED(mesh)) THEN
191  generated_mesh=>mesh%GENERATED_MESH
192  IF(ASSOCIATED(generated_mesh)) THEN
193  nodes_mapping=>decomposition%DOMAIN(1)%PTR%MAPPINGS%NODES !HACK - ALL CHECKING INTERMEDIATE SKIPPED
194  IF(ASSOCIATED(nodes_mapping)) THEN
195  !Get surfaces (hardcoded): fix two nodes on the bottom face, pressure conditions inside & outside
196  CALL generated_mesh_surface_get(generated_mesh,mesh_component,1_intg, &
197  & inner_surface_nodes,inner_normal_xi,err,error,*999) !Inner
198  CALL generated_mesh_surface_get(generated_mesh,mesh_component,2_intg, &
199  & outer_surface_nodes,outer_normal_xi,err,error,*999) !Outer
200  CALL generated_mesh_surface_get(generated_mesh,mesh_component,3_intg, &
201  & top_surface_nodes,top_normal_xi,err,error,*999) !Top
202  CALL generated_mesh_surface_get(generated_mesh,mesh_component,4_intg, &
203  & bottom_surface_nodes,bottom_normal_xi,err,error,*999) !Bottom
204  !Set all inner surface nodes to inner pressure (- sign is to make positive P into a compressive force) ?
205  pin=equations_set%ANALYTIC%ANALYTIC_USER_PARAMS(finite_elasticity_analytic_cylinder_param_pin_idx)
206  DO node_idx=1,SIZE(inner_surface_nodes,1)
207  user_node=inner_surface_nodes(node_idx)
208  !Need to test if this node is in current decomposition
209  CALL decomposition_node_domain_get(decomposition,user_node,1,domain_number,err,error,*999)
210  IF(domain_number==my_computational_node_number) THEN
211  !Default to version 1 of each node derivative
212  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_deludeln_variable_type,1,1, &
213  & user_node,abs(inner_normal_xi),boundary_condition_pressure_incremented,pin,err,error,*999)
214  ENDIF
215  ENDDO
216  !Set all outer surface nodes to outer pressure
217  pout=equations_set%ANALYTIC%ANALYTIC_USER_PARAMS(finite_elasticity_analytic_cylinder_param_pout_idx)
218  DO node_idx=1,SIZE(outer_surface_nodes,1)
219  user_node=outer_surface_nodes(node_idx)
220  !Need to test if this node is in current decomposition
221  CALL decomposition_node_domain_get(decomposition,user_node,1,domain_number,err,error,*999)
222  IF(domain_number==my_computational_node_number) THEN
223  !Default to version 1 of each node derivative
224  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_deludeln_variable_type,1,1, &
225  & user_node,abs(outer_normal_xi),boundary_condition_pressure_incremented,pout,err,error,*999)
226  ENDIF
227  ENDDO
228  !Set all top nodes fixed in z plane at lambda*height
229  lambda=equations_set%ANALYTIC%ANALYTIC_USER_PARAMS(finite_elasticity_analytic_cylinder_param_lambda_idx)
230  DO node_idx=1,SIZE(top_surface_nodes,1)
231  user_node=top_surface_nodes(node_idx)
232  !Need to test if this node is in current decomposition
233  CALL decomposition_node_domain_get(decomposition,user_node,1,domain_number,err,error,*999)
234  IF(domain_number==my_computational_node_number) THEN
235  CALL meshtopologynodecheckexists(mesh,1,user_node,node_exists,global_node,err,error,*999)
236  IF(.NOT.node_exists) cycle
237  CALL domain_mappings_global_to_local_get(nodes_mapping,global_node,node_exists,local_node,err,error,*999)
238  !Default to version 1 of each node derivative
239  local_ny=geometric_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(local_node)% &
240  & derivatives(1)%VERSIONS(1)
241  deformed_z=geometric_parameters(local_ny)*lambda
242  !Default to version 1 of each node derivative
243  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_u_variable_type,1,1, &
244  & user_node,abs(top_normal_xi),boundary_condition_fixed,deformed_z,err,error,*999)
245  ENDIF
246  ENDDO
247  !Set all bottom nodes fixed in z plane
248  DO node_idx=1,SIZE(bottom_surface_nodes,1)
249  user_node=bottom_surface_nodes(node_idx)
250  !Need to check this node exists in the current domain
251  CALL decomposition_node_domain_get(decomposition,user_node,1,domain_number,err,error,*999)
252  IF(domain_number==my_computational_node_number) THEN
253  !Default to version 1 of each node derivative
254  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_u_variable_type,1,1, &
255  & user_node,abs(bottom_normal_xi),boundary_condition_fixed,0.0_dp,err,error,*999)
256  ENDIF
257  ENDDO
258  !Set two nodes on the bottom surface to axial displacement only:
259  !Easier for parallel: Fix everything that can be fixed !!!
260  x_fixed=.false.
261  y_fixed=.false.
262  DO node_idx=1,SIZE(bottom_surface_nodes,1)
263  user_node=bottom_surface_nodes(node_idx)
264  CALL decomposition_node_domain_get(decomposition,user_node,1,domain_number,err,error,*999)
265  IF(domain_number==my_computational_node_number) THEN
266  CALL meshtopologynodecheckexists(mesh,1,user_node,node_exists,global_node,err,error,*999)
267  IF(.NOT.node_exists) cycle
268  CALL domain_mappings_global_to_local_get(nodes_mapping,global_node,node_exists,local_node,err,error,*999)
269  !Default to version 1 of each node derivative
270  local_ny=geometric_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(local_node)% &
271  & derivatives(1)%VERSIONS(1)
272  x(1)=geometric_parameters(local_ny)
273  CALL meshtopologynodecheckexists(mesh,1,user_node,node_exists,global_node,err,error,*999)
274  IF(.NOT.node_exists) cycle
275  CALL domain_mappings_global_to_local_get(nodes_mapping,global_node,node_exists,local_node, &
276  & err,error,*999)
277  !Default to version 1 of each node derivative
278  local_ny=geometric_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(local_node)% &
279  & derivatives(1)%VERSIONS(1)
280  x(2)=geometric_parameters(local_ny)
281  IF(abs(x(1))<1e-7_dp) THEN
282  !Default to version 1 of each node derivative
283  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_u_variable_type,1,1, &
284  & user_node,1,boundary_condition_fixed,0.0_dp,err,error,*999)
285 
286  x_fixed=.true.
287  ENDIF
288  IF(abs(x(2))<1e-7_dp) THEN
289  !Default to version 1 of each node derivative
290  CALL boundary_conditions_set_node(boundary_conditions,dependent_field,field_u_variable_type,1,1, &
291  & user_node,2,boundary_condition_fixed,0.0_dp,err,error,*999)
292 
293  y_fixed=.true.
294  ENDIF
295  ENDIF
296  ENDDO
297  !Check it went well
298  CALL mpi_reduce(x_fixed,x_okay,1,mpi_logical,mpi_lor,0,mpi_comm_world,mpi_ierror)
299  CALL mpi_reduce(y_fixed,y_okay,1,mpi_logical,mpi_lor,0,mpi_comm_world,mpi_ierror)
300  IF(my_computational_node_number==0) THEN
301  IF(.NOT.(x_okay.AND.y_okay)) THEN
302  CALL flagerror("Could not fix nodes to prevent rigid body motion",err,error,*999)
303  ENDIF
304  ENDIF
305  ELSE
306  CALL flagerror("Domain nodes mapping is not associated.",err,error,*999)
307  ENDIF
308  ELSE
309  CALL flagerror("Generated mesh is not associated. For the Cylinder analytic solution, "// &
310  & "it must be available for automatic boundary condition assignment",err,error,*999)
311  ENDIF
312  ELSE
313  CALL flagerror("Mesh is not associated",err,error,*999)
314  ENDIF
315  ELSE
316  CALL flagerror("Decomposition is not associated",err,error,*999)
317  ENDIF
318 
319  !Now calculate analytic solution
320  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
321  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
322  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
323  IF(variable_idx==1) CALL write_string_value(general_output_type," Global number of dofs : ", &
324  & field_variable%NUMBER_OF_GLOBAL_DOFS,err,error,*999)
325  IF(ASSOCIATED(field_variable)) THEN
326  CALL field_parameter_set_create(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
327  component_idx=1 !Assuming components 1..3 use a common mesh component and 4 uses a different one
328  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
329  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
330  IF(ASSOCIATED(domain)) THEN
331  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
332  domain_nodes=>domain%TOPOLOGY%NODES
333  IF(ASSOCIATED(domain_nodes)) THEN
334  !Also grab the equivalent pointer for pressure component
335  IF(field_variable%COMPONENTS(4)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
336  domain_pressure=>field_variable%COMPONENTS(4)%DOMAIN
337  IF(ASSOCIATED(domain_pressure)) THEN
338  IF(ASSOCIATED(domain_pressure%TOPOLOGY)) THEN
339  domain_pressure_nodes=>domain_pressure%TOPOLOGY%NODES
340  IF(ASSOCIATED(domain_pressure_nodes)) THEN
341 
342  !Loop over the local nodes excluding the ghosts.
343  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
344  !!TODO \todo We should interpolate the geometric field here and the node position.
345  DO dim_idx=1,number_of_dimensions
346  !Default to version 1 of each node derivative
347  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
348  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
349  x(dim_idx)=geometric_parameters(local_ny)
350  ENDDO !dim_idx
351  !Loop over the derivatives
352  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
353  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
354  CASE(equations_set_finite_elasticity_cylinder)
355  !Cylinder inflation, extension, torsion
356  SELECT CASE(variable_type)
357  CASE(field_u_variable_type)
358  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
359  CASE(no_global_deriv)
360  !Do all components at the same time (r,theta,z)->(x,y,z) & p
361  CALL finiteelasticity_cylinderanalyticcalculate(x, &
362  & equations_set%ANALYTIC%ANALYTIC_USER_PARAMS,deformed_x,p,err,error,*999)
363  CASE(global_deriv_s1)
364  CALL flagerror("Not implemented.",err,error,*999)
365  CASE(global_deriv_s2)
366  CALL flagerror("Not implemented.",err,error,*999)
367  CASE(global_deriv_s1_s2)
368  CALL flagerror("Not implemented.",err,error,*999)
369  CASE DEFAULT
370  local_error="The global derivative index of "//trim(number_to_vstring( &
371  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
372  & err,error))//" is invalid."
373  CALL flagerror(local_error,err,error,*999)
374  END SELECT
375  CASE(field_deludeln_variable_type)
376  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
377  CASE(no_global_deriv)
378  !Not implemented, but don't want to cause an error so do nothing
379  CASE(global_deriv_s1)
380  CALL flagerror("Not implemented.",err,error,*999)
381  CASE(global_deriv_s2)
382  CALL flagerror("Not implemented.",err,error,*999)
383  CASE(global_deriv_s1_s2)
384  CALL flagerror("Not implemented.",err,error,*999)
385  CASE DEFAULT
386  local_error="The global derivative index of "//trim(number_to_vstring( &
387  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
388  & err,error))//" is invalid."
389  CALL flagerror(local_error,err,error,*999)
390  END SELECT
391  CASE DEFAULT
392  local_error="The variable type "//trim(number_to_vstring(variable_type,"*",err,error)) &
393  & //" is invalid."
394  CALL flagerror(local_error,err,error,*999)
395  END SELECT
396  CASE DEFAULT
397  local_error="The analytic function type of "// &
398  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
399  & " is invalid."
400  CALL flagerror(local_error,err,error,*999)
401  END SELECT
402  !Set the analytic solution to parameter set
403  DO component_idx=1,number_of_dimensions
404  !Default to version 1 of each node derivative
405  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
406  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
407  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
408  & field_analytic_values_set_type,local_ny,deformed_x(component_idx),err,error,*999)
409  ENDDO
410  !Don't forget the pressure component
411  user_node=domain_nodes%NODES(node_idx)%USER_NUMBER
412  CALL meshtopologynodecheckexists(mesh,domain_pressure%MESH_COMPONENT_NUMBER,user_node, &
413  & node_exists,global_node,err,error,*999)
414  IF(node_exists) THEN
415  CALL decomposition_node_domain_get(decomposition,user_node, &
416  & domain_pressure%MESH_COMPONENT_NUMBER,domain_number,err,error,*999)
417  IF(domain_number==my_computational_node_number) THEN
418  !\todo: test the domain node mappings pointer properly
419  local_node=domain_pressure%mappings%nodes%global_to_local_map(global_node)%local_number(1)
420  !Default to version 1 of each node derivative
421  local_ny=field_variable%COMPONENTS(4)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
422  & nodes(local_node)%DERIVATIVES(deriv_idx)%VERSIONS(1)
423  !Because p=2.lambda in this particular constitutive law, we'll assign half the
424  !hydrostatic pressure to the analytic array
425  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
426  & field_analytic_values_set_type,local_ny,p/2.0_dp,err,error,*999)
427  ENDIF
428  ENDIF
429  ENDDO !deriv_idx
430  ENDDO !node_idx
431 
432  ELSE
433  CALL flagerror("Domain for pressure topology node is not associated",err,error,*999)
434  ENDIF
435  ELSE
436  CALL flagerror("Domain for pressure topology is not associated",err,error,*999)
437  ENDIF
438  ELSE
439  CALL flagerror("Domain for pressure component is not associated",err,error,*999)
440  ENDIF
441  ELSE
442  CALL flagerror("Non-nodal based interpolation of pressure cannot be used with analytic solutions", &
443  & err,error,*999)
444  ENDIF
445  ELSE
446  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
447  ENDIF
448  ELSE
449  CALL flagerror("Domain topology is not associated.",err,error,*999)
450  ENDIF
451  ELSE
452  CALL flagerror("Domain is not associated.",err,error,*999)
453  ENDIF
454  ELSE
455  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
456  ENDIF
457  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
458  & err,error,*999)
459  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
460  & err,error,*999)
461  ELSE
462  CALL flagerror("Field variable is not associated.",err,error,*999)
463  ENDIF
464 
465  ENDDO !variable_idx
466  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
467  & geometric_parameters,err,error,*999)
468  ELSE
469  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
470  ENDIF
471  ELSE
472  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
473  ENDIF
474  ELSE
475  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
476  ENDIF
477  ELSE
478  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
479  ENDIF
480  ELSE
481  CALL flagerror("Equations set is not associated.",err,error,*999)
482  ENDIF
483 
484 
485  exits("FiniteElasticity_BoundaryConditionsAnalyticCalculate")
486  RETURN
487 999 errors("FiniteElasticity_BoundaryConditionsAnalyticCalculate",err,error)
488  exits("FiniteElasticity_BoundaryConditionsAnalyticCalculate")
489  RETURN 1
490 
491  END SUBROUTINE finiteelasticity_boundaryconditionsanalyticcalculate
492 
493  !
494  !================================================================================================================================
495  !
496 
498  SUBROUTINE finiteelasticity_cylinderanalyticcalculate(X,ANALYTIC_USER_PARAMS,DEFORMED_X,P,ERR,ERROR,*)
499  !Argument variables
500  REAL(DP), INTENT(IN) :: X(:)
501  REAL(DP), INTENT(IN) :: ANALYTIC_USER_PARAMS(:)
502  REAL(DP), INTENT(OUT) :: DEFORMED_X(3)
503  REAL(DP), INTENT(OUT) :: P
504  INTEGER(INTG), INTENT(OUT) :: ERR
505  TYPE(varying_string), INTENT(OUT) :: ERROR
506  !Local variables
507  REAL(DP) :: PIN,POUT,LAMBDA,TSI,A1,A2,C1,C2 !A1=external radius, A2=internal radius
508  REAL(DP) :: MU1,MU2,MU,K
509  REAL(DP) :: F,F2,DF
510  REAL(DP) :: R,THETA ! Undeformed coordinates in radial coordinates
511  REAL(DP) :: DEFORMED_R,DEFORMED_THETA
512  REAL(DP) :: DELTA,RES
513  REAL(DP), PARAMETER :: STEP=1e-5_dp, reltol=1e-12_dp
514 
515 
516  enters("FiniteElasticity_CylinderAnalyticCalculate",err,error,*999)
517 
518  !Grab problem parameters
519  pin=analytic_user_params(finite_elasticity_analytic_cylinder_param_pin_idx)
520  pout=analytic_user_params(finite_elasticity_analytic_cylinder_param_pout_idx)
521  lambda=analytic_user_params(finite_elasticity_analytic_cylinder_param_lambda_idx)
522  tsi=analytic_user_params(finite_elasticity_analytic_cylinder_param_tsi_idx)
523  a1=analytic_user_params(finite_elasticity_analytic_cylinder_param_rout_idx) ! external radius
524  a2=analytic_user_params(finite_elasticity_analytic_cylinder_param_rin_idx) ! internal radius
525  c1=analytic_user_params(finite_elasticity_analytic_cylinder_param_c1_idx)
526  c2=analytic_user_params(finite_elasticity_analytic_cylinder_param_c2_idx)
527 
528  !Solve for MU1 - Newton's method (\todo: Implement here, or separate out for general use?)
529  mu1=1.0_dp !Initial guess - need a better way!
530  DO
531  !Calculate f(MU1)
532  f=finite_elasticity_cylinder_analytic_func_evaluate(mu1,pin,pout,lambda,tsi,a1,a2,c1,c2)
533 
534  !Calculate f'(MU1) by finite differencing
535  f2=finite_elasticity_cylinder_analytic_func_evaluate(mu1+step,pin,pout,lambda,tsi,a1,a2,c1,c2)
536  df=(f2-f)/step
537 
538  !Next increment for MU1
539  delta=-f/df
540 
541  !Ensure that the step actually reduces residual
542  f2=finite_elasticity_cylinder_analytic_func_evaluate(mu1+delta,pin,pout,lambda,tsi,a1,a2,c1,c2)
543  DO
544  IF (abs(f2)<abs(f).OR.abs(f2)<zero_tolerance) THEN ! PASS
545  mu1=mu1+delta
546  EXIT
547  ELSEIF (delta<1e-3_dp) THEN ! FAIL: It's likely that the initial guess is too far away
548  CALL flagerror("FiniteElasticity_CylinderAnalyticCalculate failed to converge.",err,error,*999)
549  ELSE ! KEEP GOING
550  delta=delta/2.0_dp
551  f2=finite_elasticity_cylinder_analytic_func_evaluate(mu1+delta,pin,pout,lambda,tsi,a1,a2,c1,c2)
552  ENDIF
553  ENDDO
554 
555  !Test for convergence: relative residual
556  res=delta/(1.0_dp+mu1)
557  IF (res<reltol) EXIT
558  ENDDO
559 
560  !Calculate MU2
561  mu2=sqrt(((a1/a2)**2*(lambda*mu1**2-1.0_dp)+1.0_dp)/lambda)
562 
563  !Calculate radius and angle from undeformed coordinates
564  r=sqrt(x(1)**2+x(2)**2)
565  theta=atan2(x(2),x(1)) ! in radians
566 
567  !Calculate deformed coordinates
568  k=a1**2*(lambda*mu1**2-1.0_dp)
569  mu=sqrt(1.0_dp/lambda*(1.0_dp+k/r**2))
570  deformed_r=mu*r
571  deformed_theta=theta+tsi*lambda*x(3)
572  deformed_x(1)=deformed_r*cos(deformed_theta)
573  deformed_x(2)=deformed_r*sin(deformed_theta)
574  deformed_x(3)=lambda*x(3)
575 
576  !Calculate pressure
577  p=pout-(c1/lambda+c2*lambda)*(1.0_dp/lambda/mu1**2-r**2/(r**2+k)+log(mu**2/mu1**2))+c1*tsi**2*lambda*(r**2-a1**2) &
578  & -2.0_dp*(c1/lambda**2/mu**2+c2*(1.0_dp/lambda**2+1.0_dp/mu**2+tsi**2*r**2))
579 
580  exits("FiniteElasticity_CylinderAnalyticCalculate")
581  RETURN
582 999 errorsexits("FiniteElasticity_CylinderAnalyticCalculate",err,error)
583  RETURN 1
584 
585  END SUBROUTINE finiteelasticity_cylinderanalyticcalculate
586 
587  !
588  !================================================================================================================================
589  !
590 
592  FUNCTION finite_elasticity_cylinder_analytic_func_evaluate(MU1,PIN,POUT,LAMBDA,TSI,A1,A2,C1,C2)
593  !Argument variables
594  REAL(DP) :: FINITE_ELASTICITY_CYLINDER_ANALYTIC_FUNC_EVALUATE
595  REAL(DP) :: MU1,PIN,POUT,LAMBDA,TSI,A1,A2,C1,C2
596  !Local variables
597  REAL(DP) :: MU,K
598 
599  k=a1**2*(lambda*mu1**2-1.0_dp)
600  mu=sqrt(1.0_dp/lambda*(1.0_dp+k/a2**2))
601 
602  finite_elasticity_cylinder_analytic_func_evaluate= &
603  & 2.0_dp*(c1/lambda**2/mu**2 + c2*(1.0_dp/lambda**2+1.0_dp/mu**2+tsi**2*a2**2))+ &
604  & pout-(c1/lambda+c2*lambda)*(1.0_dp/lambda/mu1**2-a2**2/(a2**2+k)+2*log(mu/mu1))+ &
605  & c1*tsi**2*lambda*(a2**2-a1**2)-2.0_dp*(c1/lambda**2/mu**2+c2*(1.0_dp/lambda**2+ &
606  & 1.0_dp/mu**2+tsi**2*a2**2))+pin
607 
608  RETURN
609  END FUNCTION finite_elasticity_cylinder_analytic_func_evaluate
610 
611  !
612  !================================================================================================================================
613  !
614 
616  SUBROUTINE finite_elasticity_gauss_elasticity_tensor(EQUATIONS_SET,DEPENDENT_INTERPOLATED_POINT, &
617  & materials_interpolated_point,elasticity_tensor,hydro_elasticity_voigt,stress_tensor,dzdnu, &
618  & jznu,element_number,gauss_point_number,err,error,*)
619  !Argument variables
620  TYPE(equations_set_type), POINTER, INTENT(IN) :: EQUATIONS_SET
621  TYPE(field_interpolated_point_type), POINTER :: DEPENDENT_INTERPOLATED_POINT,MATERIALS_INTERPOLATED_POINT
622  REAL(DP), INTENT(OUT) :: ELASTICITY_TENSOR(:,:)
623  REAL(DP), INTENT(OUT) :: HYDRO_ELASTICITY_VOIGT(:)
624  REAL(DP), INTENT(OUT) :: STRESS_TENSOR(:)
625  REAL(DP), INTENT(IN) :: DZDNU(:,:)
626  REAL(DP), INTENT(IN) :: Jznu
627  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER,GAUSS_POINT_NUMBER
628  INTEGER(INTG), INTENT(OUT) :: ERR
629  TYPE(varying_string), INTENT(OUT) :: ERROR
630  !Local Variables
631  INTEGER(INTG) :: PRESSURE_COMPONENT,i,j,dof_idx
632  REAL(DP) :: P, I1, I3
633  REAL(DP) :: DZDNUT(3,3),AZL(3,3),AZU(3,3),TEMP(3,3)
634  REAL(DP) :: AZLv(6), AZUv(6)
635  REAL(DP) :: TEMPTERM1,TEMPTERM2,VALUE
636  REAL(DP), POINTER :: C(:) !Parameters for constitutive laws
637  REAL(DP) :: B(6),E(6),DQ_DE(6),Q
638  REAL(DP) :: I3EE(6,6)
639  REAL(DP) :: ADJCC(6,6)
640  REAL(DP) :: AZUE(6,6)
641  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
642  TYPE(varying_string) :: LOCAL_ERROR
643 
644  enters("FINITE_ELASTICITY_GAUSS_ELASTICITY_TENSOR",err,error,*999)
645 
646  NULLIFY(field_variable,c)
647 
648  !AZL = F'*F (deformed covariant or right cauchy deformation tensor, C)
649  !AZU - deformed contravariant tensor; I3 = det(C)
650  !E = Green-Lagrange strain tensor = 0.5*(C-I)
651  !P is the hydrostatic pressure
652 
653  ! Evaluate the Cauchy strain tensor C.
654  CALL matrix_transpose(dzdnu,dzdnut,err,error,*999)
655  CALL matrix_product(dzdnut,dzdnu,azl,err,error,*999)
656  CALL invert(azl,azu,i3,err,error,*999)
657 
658  ! Evaluate the derivative of AZU wrt to E (AZUE) for the hydrostatic term. Formulation from Nam-Ho Kim book, pg.198.
659  azlv(1) = azl(1,1)
660  azlv(2) = azl(2,2)
661  azlv(3) = azl(3,3)
662  azlv(4) = azl(1,2)
663  azlv(5) = azl(1,3)
664  azlv(6) = azl(2,3)
665  azuv(1) = azu(1,1)
666  azuv(2) = azu(2,2)
667  azuv(3) = azu(3,3)
668  azuv(4) = azu(1,2)
669  azuv(5) = azu(1,3)
670  azuv(6) = azu(2,3)
671  i3ee = reshape([0.0_dp, 4.0_dp*azlv(3), 4.0_dp*azlv(2), 0.0_dp, 0.0_dp,-4.0_dp*azlv(6), &
672  & 4.0_dp*azlv(3), 0.0_dp, 4.0_dp*azlv(1), 0.0_dp,-4.0_dp*azlv(5), 0.0_dp, &
673  & 4.0_dp*azlv(2), 4.0_dp*azlv(1), 0.0_dp, -2.0_dp*azlv(4), 0.0_dp, 0.0_dp, &
674  & 0.0_dp, 0.0_dp, -4.0_dp*azlv(4), -2.0_dp*azlv(3), 2.0_dp*azlv(6), 2.0_dp*azlv(5), &
675  & 0.0_dp, -4.0_dp*azlv(5), 0.0_dp, 2.0_dp*azlv(6), -2.0_dp*azlv(2), 2.0_dp*azlv(4), &
676  & -4.0_dp*azlv(6), 0.0_dp, 0.0_dp, 2.0_dp*azlv(5), 2.0_dp*azlv(4), -2.0_dp*azlv(1)], [6,6])
677  adjcc = reshape([0.0_dp, azlv(3), azlv(2), 0.0_dp, 0.0_dp,-azlv(6), &
678  & azlv(3), 0.0_dp, azlv(1), 0.0_dp,-azlv(5), 0.0_dp, &
679  & azlv(2), azlv(1), 0.0_dp, -azlv(4), 0.0_dp, 0.0_dp, &
680  & 0.0_dp, 0.0_dp, -azlv(4), -0.5_dp*azlv(3), 0.5_dp*azlv(6), 0.5_dp*azlv(5), &
681  & 0.0_dp, -azlv(5), 0.0_dp,0.5_dp*azlv(6), -0.5_dp*azlv(2), 0.5_dp*azlv(4), &
682  & -azlv(6), 0.0_dp, 0.0_dp, 0.5_dp*azlv(5), 0.5_dp*azlv(4), -0.5_dp*azlv(1)], [6,6])
683  !DO i=1,6
684  ! DO j=1,6
685  ! AZUE(i,j) = -2.0_DP*AZUv(i)*AZUv(j) + 2.0_DP*ADJCC(i,j)/I3
686  ! ENDDO
687  !ENDDO
688 
689  DO i=1,6
690  DO j=1,6
691  azue(i,j) = -2.0_dp*azuv(i)*azuv(j) + 0.5_dp*i3ee(i,j)/i3
692  ENDDO
693  ENDDO
694 
695  c=>materials_interpolated_point%VALUES(:,no_part_deriv)
696 
697  elasticity_tensor=0.0_dp
698 
699  SELECT CASE(equations_set%specification(3))
700  CASE(equations_set_mooney_rivlin_activecontraction_subtype,equations_set_mooney_rivlin_subtype)
701  local_error="Analytic Jacobian has not been validated for the Mooney-Rivlin equations, please use finite differences instead."
702  CALL flagerror(local_error,err,error,*999)
703  pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE%NUMBER_OF_COMPONENTS
704  p=dependent_interpolated_point%VALUES(pressure_component,no_part_deriv)
705  !Form of constitutive model is:
706  ! W=c1*(I1-3)+c2*(I2-3)+p/2*(I3-1)
707 
708  ! Calculate isochoric fictitious 2nd Piola tensor (in Voigt form)
709  i1=azl(1,1)+azl(2,2)+azl(3,3)
710  tempterm1=-2.0_dp*c(2)
711  tempterm2=2.0_dp*(c(1)+i1*c(2))
712  stress_tensor(1)=tempterm1*azl(1,1)+tempterm2
713  stress_tensor(2)=tempterm1*azl(2,2)+tempterm2
714  stress_tensor(3)=tempterm1*azl(3,3)+tempterm2
715  stress_tensor(4)=tempterm1*azl(2,1)
716  stress_tensor(5)=tempterm1*azl(3,1)
717  stress_tensor(6)=tempterm1*azl(3,2)
718  IF(equations_set%specification(3)==equations_set_mooney_rivlin_activecontraction_subtype) THEN
719 
720  !add active contraction stress values
721  !Be aware for modified DZDNU, should active contraction be added here? Normally should be okay as modified DZDNU and DZDNU
722  !converge during the Newton iteration.
723  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
724  DO i=1,field_variable%NUMBER_OF_COMPONENTS
725  dof_idx=field_variable%COMPONENTS(i)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
726  & gauss_points(gauss_point_number,element_number)
727  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
728  & field_values_set_type,dof_idx,VALUE,err,error,*999)
729  stress_tensor(i)=stress_tensor(i)+VALUE
730  ENDDO
731  ENDIF
732 
733  ! Calculate material elasticity tensor (in Voigt form) as
734  ! this will be compensated for in the push-forward with the modified deformation gradient.
735  tempterm1=4.0_dp*c(2)
736  tempterm2=-2.0_dp*c(2)
737  elasticity_tensor(2,1)=tempterm1
738  elasticity_tensor(3,1)=tempterm1
739  elasticity_tensor(1,2)=tempterm1
740  elasticity_tensor(3,2)=tempterm1
741  elasticity_tensor(1,3)=tempterm1
742  elasticity_tensor(2,3)=tempterm1
743  elasticity_tensor(4,4)=tempterm2
744  elasticity_tensor(5,5)=tempterm2
745  elasticity_tensor(6,6)=tempterm2
746  !Add volumetric part of elasticity tensor - p*d(C^-1)/dE.
747  elasticity_tensor=elasticity_tensor + p*azue
748 
749  !Hydrostatic portion of the elasticity tensor (dS/dp)
750  hydro_elasticity_voigt = azuv
751 
752  ! Do push-forward of 2nd Piola tensor and the material elasticity tensor.
753  CALL finite_elasticity_push_stress_tensor(stress_tensor,dzdnu,jznu,err,error,*999)
754  CALL finite_elasticity_push_stress_tensor(hydro_elasticity_voigt,dzdnu,jznu,err,error,*999)
755  CALL finite_elasticity_push_elasticity_tensor(elasticity_tensor,dzdnu,jznu,err,error,*999)
756 
757  ! Add volumetric parts.
758  stress_tensor(1:3)=stress_tensor(1:3)+p
759 
760  CASE(equations_set_transverse_isotropic_guccione_subtype,equations_set_guccione_activecontraction_subtype)
761  pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE%NUMBER_OF_COMPONENTS
762  p=dependent_interpolated_point%VALUES(pressure_component,no_part_deriv)
763  b=[2.0_dp*c(2),2.0_dp*c(3),2.0_dp*c(3),c(4),c(4),c(3)] ![2*b_f,2*b_t,2*b_t,b_ft,b_ft,b_t]
764  e=[0.5_dp*(azl(1,1)-1.0_dp),0.5_dp*(azl(2,2)-1.0_dp),0.5_dp*(azl(3,3)-1.0_dp),azl(2,1),azl(3,1),azl(3,2)] !(Modified) strain tensor in Voigt form.
765  dq_de=b*e
766  tempterm1=0.5_dp*c(1)*exp(0.5_dp*dot_product(e,dq_de))
767  !Calculate 2nd Piola tensor (in Voigt form)
768  stress_tensor=tempterm1*dq_de + p*azuv
769  IF(equations_set%specification(3)==equations_set_guccione_activecontraction_subtype) THEN
770  !add active contraction stress values
771  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
772  DO i=1,field_variable%NUMBER_OF_COMPONENTS
773  dof_idx=field_variable%COMPONENTS(i)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
774  & gauss_points(gauss_point_number,element_number)
775  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
776  & field_values_set_type,dof_idx,VALUE,err,error,*999)
777  stress_tensor(i)=stress_tensor(i)+VALUE
778  ENDDO
779  ENDIF
780 
781  !\todo blas has routines specifically for symmetric matrices, so it would be worth to check if these could give some speedup.
782 
783  ! Calculate material elasticity tensor c (in Voigt form).
784  ! First calculate lower part of 6X6 matrix
785  DO j=1,6
786  DO i=j,6
787  elasticity_tensor(i,j)=tempterm1*dq_de(i)*dq_de(j)
788  ENDDO
789  ENDDO
790  b=[2.0_dp*c(2),2.0_dp*c(3),2.0_dp*c(3),c(4),c(4),c(3)]
791  DO i=1,6
792  elasticity_tensor(i,i)=elasticity_tensor(i,i)+tempterm1*b(i)
793  ENDDO
794  ! Then calculate upper part.
795  DO j=2,6
796  DO i=1,j-1
797  elasticity_tensor(i,j)=elasticity_tensor(j,i)
798  ENDDO
799  ENDDO
800 
801  !Add volumetric part of elasticity tensor - p*d(C^-1)/dE.
802  elasticity_tensor=elasticity_tensor + p*azue
803 
804  !Hydrostatic portion of the elasticity tensor (dS/dp)
805  hydro_elasticity_voigt = azuv
806 
807  !Do push-forward of 2nd Piola tensor and the material elasticity tensor.
808  CALL finite_elasticity_push_stress_tensor(stress_tensor,dzdnu,jznu,err,error,*999)
809  CALL finite_elasticity_push_stress_tensor(hydro_elasticity_voigt,dzdnu,jznu,err,error,*999)
810  CALL finite_elasticity_push_elasticity_tensor(elasticity_tensor,dzdnu,jznu,err,error,*999)
811  CASE DEFAULT
812  local_error="Analytic Jacobian has not been implemented for the third equations set specification of "// &
813  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))
814  CALL flagerror(local_error,err,error,*999)
815  END SELECT
816 
817  exits("FINITE_ELASTICITY_GAUSS_ELASTICITY_TENSOR")
818  RETURN
819 999 errorsexits("FINITE_ELASTICITY_GAUSS_ELASTICITY_TENSOR",err,error)
820  RETURN 1
821 
822  END SUBROUTINE finite_elasticity_gauss_elasticity_tensor
823 
824 
825 
826  !
827  !================================================================================================================================
828  !
829 
831  SUBROUTINE finiteelasticity_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
832  !Argument variables
833  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
834  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
835  INTEGER(INTG), INTENT(OUT) :: ERR
836  TYPE(varying_string), INTENT(OUT) :: ERROR
837  !Local Variables
838  INTEGER(INTG) :: FIELD_VAR_TYPE,ng,nh,ns,nhs,ni,mh,ms,mhs,oh
839  INTEGER(INTG) :: PRESSURE_COMPONENT
840  INTEGER(INTG) :: SUM_ELEMENT_PARAMETERS,TOTAL_NUMBER_OF_SURFACE_PRESSURE_CONDITIONS
841  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NUMBER_OF_XI
842  INTEGER(INTG) :: ELEMENT_BASE_DOF_INDEX(4),component_idx,component_idx2
843  INTEGER(INTG), PARAMETER :: OFF_DIAG_COMP(3)=[0,1,3],off_diag_dep_var1(3)=[1,1,2],off_diag_dep_var2(3)=[2,3,3]
844  INTEGER(INTG) :: MESH_COMPONENT_NUMBER,NUMBER_OF_ELEMENT_PARAMETERS(4)
845  REAL(DP) :: DZDNU(3,3),CAUCHY_TENSOR(3,3),HYDRO_ELASTICITY_TENSOR(3,3)
846  REAL(DP) :: JGW_SUB_MAT(3,3)
847  REAL(DP) :: TEMPVEC(3)
848  REAL(DP) :: STRESS_TENSOR(6),ELASTICITY_TENSOR(6,6),HYDRO_ELASTICITY_VOIGT(6)
849  REAL(DP) :: DPHIDZ(3,64,3),DJDZ(64,3)
850  REAL(DP) :: JGW_DPHINS_DZ,JGW_DPHIMS_DZ,PHIMS,PHINS,TEMPTERM
851  REAL(DP) :: Jznu,JGW,SUM1,SUM2
852  TYPE(quadrature_scheme_ptr_type) :: QUADRATURE_SCHEMES(4)
853  TYPE(basis_type), POINTER :: DEPENDENT_BASIS
854  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
855  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
856  TYPE(field_interpolated_point_type), POINTER :: GEOMETRIC_INTERP_POINT,FIBRE_INTERP_POINT, &
857  & MATERIALS_INTERP_POINT,DEPENDENT_INTERP_POINT
858  TYPE(field_interpolated_point_metrics_type), POINTER :: GEOMETRIC_INTERP_POINT_METRICS, &
859  & DEPENDENT_INTERP_POINT_METRICS
860  TYPE(equations_type), POINTER :: EQUATIONS
861  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
862  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
863  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
864  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
865  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
866  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,FIBRE_FIELD
867  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
868  TYPE(quadrature_scheme_type), POINTER :: DEPENDENT_QUADRATURE_SCHEME
869 
870  enters("FiniteElasticity_FiniteElementJacobianEvaluate",err,error,*999)
871 
872  IF(ASSOCIATED(equations_set)) THEN
873  equations=>equations_set%EQUATIONS
874  IF(ASSOCIATED(equations)) THEN
875  equations_matrices=>equations%EQUATIONS_MATRICES
876  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
877  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
878  IF(jacobian_matrix%UPDATE_JACOBIAN) THEN
879  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
880  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
881  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
882  fibre_field=>equations%INTERPOLATION%FIBRE_FIELD
883 
884  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
885  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
886  dependent_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
887 
888  number_of_dimensions=equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
889  number_of_xi=dependent_basis%NUMBER_OF_XI
890 
891  equations_mapping=>equations%EQUATIONS_MAPPING
892  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
893 
894  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
895  field_var_type=field_variable%VARIABLE_TYPE
896 
897  pressure_component=field_variable%NUMBER_OF_COMPONENTS
898 
899  boundary_conditions=>equations_set%BOUNDARY_CONDITIONS
900  CALL boundary_conditions_variable_get(boundary_conditions,equations_set%EQUATIONS%EQUATIONS_MAPPING%RHS_MAPPING% &
901  & rhs_variable,boundary_conditions_variable,err,error,*999)
902  total_number_of_surface_pressure_conditions=boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure)+ &
903  & boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure_incremented)
904 
905  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
906  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
907  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
908  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
909  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
910  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
911  IF(ASSOCIATED(fibre_field)) THEN
912  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
913  & fibre_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
914  END IF
915 
916  !Point interpolation pointer
917  geometric_interp_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
918  geometric_interp_point_metrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
919  IF(ASSOCIATED(fibre_field)) THEN
920  fibre_interp_point=>equations%INTERPOLATION%FIBRE_INTERP_POINT(field_u_variable_type)%PTR
921  END IF
922  materials_interp_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR
923  dependent_interp_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR
924  dependent_interp_point_metrics=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS(field_var_type)%PTR
925 
926  sum_element_parameters=0
927  !Loop over geometric dependent basis functions.
928  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
929  mesh_component_number=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
930  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
931  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
932  quadrature_schemes(nh)%PTR=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
933  IF(field_variable%COMPONENTS(nh)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
934  number_of_element_parameters(nh)=dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
935  ELSEIF(field_variable%COMPONENTS(nh)%INTERPOLATION_TYPE==field_element_based_interpolation) THEN
936  number_of_element_parameters(nh)=1
937  ENDIF
938  element_base_dof_index(nh)=sum_element_parameters
939  sum_element_parameters=sum_element_parameters+number_of_element_parameters(nh)
940  ENDDO !nh
941 
942  !Loop over all Gauss points
943  DO ng=1,dependent_quadrature_scheme%NUMBER_OF_GAUSS
944  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng, &
945  & dependent_interp_point,err,error,*999)
946  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng, &
947  & geometric_interp_point,err,error,*999)
948  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type, &
949  & geometric_interp_point_metrics,err,error,*999)
950  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type, &
951  & dependent_interp_point_metrics,err,error,*999)
952  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng, &
953  & materials_interp_point,err,error,*999)
954  IF(ASSOCIATED(fibre_field)) THEN
955  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng, &
956  & fibre_interp_point,err,error,*999)
957  ENDIF
958 
959  jznu=dependent_interp_point_metrics%JACOBIAN/geometric_interp_point_metrics%JACOBIAN
960  jgw=dependent_interp_point_metrics%JACOBIAN*dependent_quadrature_scheme%GAUSS_WEIGHTS(ng)
961 
962  !Loop over geometric dependent basis functions.
963  DO nh=1,number_of_dimensions
964  DO ns=1,number_of_element_parameters(nh)
965  !Loop over derivative directions.
966  sum2=0.0_dp
967  DO mh=1,number_of_dimensions
968  sum1=0.0_dp
969  DO ni=1,number_of_xi
970  sum1=sum1+quadrature_schemes(nh)%PTR%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
971  & dependent_interp_point_metrics%DXI_DX(ni,mh)
972  sum2=sum2+quadrature_schemes(mh)%PTR%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
973  & dependent_interp_point_metrics%DXI_DX(ni,mh)*dependent_interp_point_metrics%GU(ni,mh)
974  ENDDO !mi
975  dphidz(mh,ns,nh)=sum1
976  ENDDO !mh
977  djdz(ns,nh)=sum2*dependent_interp_point_metrics%JACOBIAN
978  ENDDO !ns
979  ENDDO !nh
980 
981  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interp_point_metrics, &
982  & geometric_interp_point_metrics,fibre_interp_point,dzdnu,err,error,*999)
983 
984  CALL finite_elasticity_gauss_elasticity_tensor(equations_set,dependent_interp_point, &
985  & materials_interp_point,elasticity_tensor,hydro_elasticity_voigt,stress_tensor, &
986  & dzdnu,jznu,element_number,ng,err,error,*999)
987 
988  !Convert from Voigt form to tensor form.
989  DO nh=1,number_of_dimensions
990  DO mh=1,number_of_dimensions
991  cauchy_tensor(mh,nh)=stress_tensor(tensor_to_voigt3(mh,nh))
992  hydro_elasticity_tensor(mh,nh)=hydro_elasticity_voigt(tensor_to_voigt3(mh,nh))
993  ENDDO
994  ENDDO
995 
996  !1) loop over mh=nh
997  !Loop over element columns belonging to geometric dependent variables
998  nhs=0
999  DO nh=1,number_of_dimensions
1000  jgw_sub_mat=jgw*(elasticity_tensor(tensor_to_voigt3(:,nh),tensor_to_voigt3(:,nh))+cauchy_tensor)
1001  DO ns=1,number_of_element_parameters(nh)
1002  tempvec=matmul(jgw_sub_mat,dphidz(:,ns,nh))
1003  nhs=nhs+1
1004  mhs=nhs-1
1005  !Loop over element rows belonging to geometric dependent variables
1006  DO ms=ns,number_of_element_parameters(nh)
1007  mhs=mhs+1
1008  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1009  & dot_product(dphidz(:,ms,nh),tempvec)
1010  DO component_idx=1,number_of_dimensions
1011  DO component_idx2=1,number_of_dimensions
1012  tempterm=cauchy_tensor(component_idx,component_idx2)* &
1013  & dphidz(component_idx2,ms,component_idx)
1014  ENDDO
1015  ENDDO
1016  !JACOBIAN_MATRIX%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=JACOBIAN_MATRIX%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1017  ! & TEMPTERM*DJDZ(ms,nh)*DEPENDENT_QUADRATURE_SCHEME%GAUSS_WEIGHTS(ng)
1018  ENDDO !ms
1019  ENDDO !ns
1020  ENDDO !nh
1021 
1022  !2) loop over mh>nh
1023  !Loop over element columns belonging to geometric dependent variables
1024  DO oh=1,off_diag_comp(number_of_dimensions)
1025  nh=off_diag_dep_var1(oh)
1026  mh=off_diag_dep_var2(oh)
1027  nhs=element_base_dof_index(nh)
1028  jgw_sub_mat=jgw*(elasticity_tensor(tensor_to_voigt3(:,mh),tensor_to_voigt3(:,nh)))
1029  DO ns=1,number_of_element_parameters(nh)
1030  !Loop over element rows belonging to geometric dependent variables
1031  tempvec=matmul(jgw_sub_mat,dphidz(:,ns,nh))
1032  nhs=nhs+1
1033  mhs=element_base_dof_index(mh)
1034  DO ms=1,number_of_element_parameters(mh)
1035  mhs=mhs+1
1036  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1037  & dot_product(dphidz(:,ms,mh),tempvec)
1038  DO component_idx=1,number_of_dimensions
1039  DO component_idx2=1,number_of_dimensions
1040  tempterm=cauchy_tensor(component_idx,component_idx2)* &
1041  & dphidz(component_idx2,ms,component_idx)
1042  ENDDO
1043  ENDDO
1044  !JACOBIAN_MATRIX%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=JACOBIAN_MATRIX%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1045  ! & TEMPTERM*DJDZ(ms,nh)*DEPENDENT_QUADRATURE_SCHEME%GAUSS_WEIGHTS(ng)
1046  ENDDO !ms
1047  ENDDO !ns
1048  ENDDO
1049 
1050  !3) loop over all nh and pressure component
1051  nhs=0
1052  IF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN !node based
1053  !Loop over element rows belonging to geometric dependent variables
1054  DO nh=1,number_of_dimensions
1055  DO ns=1,number_of_element_parameters(nh)
1056  jgw_dphins_dz=jgw*dphidz(nh,ns,nh)
1057  nhs=nhs+1
1058  !Loop over element rows belonging to hydrostatic pressure
1059  mhs=element_base_dof_index(pressure_component)
1060  DO ms=1,number_of_element_parameters(pressure_component)
1061  mhs=mhs+1
1062  phims=quadrature_schemes(pressure_component)%PTR%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
1063  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1064  & jgw_dphins_dz*phims
1065  ENDDO !ms
1066  ENDDO !ns
1067  ENDDO !nh
1068  ELSEIF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_element_based_interpolation) THEN !element based
1069  !Loop over element rows belonging to geometric dependent variables
1070  DO nh=1,number_of_dimensions
1071  DO ns=1,number_of_element_parameters(nh)
1072  jgw_dphins_dz=jgw*dphidz(nh,ns,nh)
1073  nhs=nhs+1
1074  !Loop over element rows belonging to hydrostatic pressure
1075  mhs=element_base_dof_index(pressure_component)+1
1076  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1077  & jgw_dphins_dz
1078  ENDDO !ns
1079  ENDDO !nh
1080  ENDIF
1081 
1082  !4) Loop over all mh pressure component
1083  mhs=0
1084  IF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN !node based
1085  !Loop over element columns belonging to geometric dependent variables.
1086  DO mh=1,number_of_dimensions
1087  DO ms=1,number_of_element_parameters(mh)
1088  tempvec=matmul(hydro_elasticity_tensor,dphidz(:,ms,mh))
1089  jgw_dphims_dz=jgw*tempvec(mh)
1090  mhs=mhs+1
1091  !Loop over element columns belonging to hydrostatic pressure
1092  nhs=element_base_dof_index(pressure_component)
1093  DO ns=1,number_of_element_parameters(pressure_component)
1094  nhs=nhs+1
1095  phins=quadrature_schemes(pressure_component)%PTR%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
1096  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
1097  & jgw_dphims_dz*phins
1098  ENDDO !ns
1099  ENDDO !ms
1100  ENDDO !mh
1101  ELSEIF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_element_based_interpolation) THEN !element based
1102  !Loop over element columns belonging to geometric dependent variables.
1103  DO mh=1,number_of_dimensions
1104  DO ms=1,number_of_element_parameters(mh)
1105  tempvec=matmul(hydro_elasticity_tensor,dphidz(:,ms,mh))
1106  jgw_dphims_dz=jgw*tempvec(mh)
1107  mhs=mhs+1
1108  !Loop over element columns belonging to hydrostatic pressure.
1109  nhs=element_base_dof_index(pressure_component)+1
1110  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs) + &
1111  & jgw_dphims_dz
1112  ENDDO !ms
1113  ENDDO !mh
1114  ENDIF
1115  ! No loop over element columns and rows belonging both to hydrostatic pressure because it is zero.
1116  ENDDO !ng
1117 
1118  !Scale factor adjustment
1119  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
1120  !Following call is necessary, otherwise wrong face scale factors from function call to surface pressure jacobian are
1121  !used.
1122  CALL field_interpolationparametersscalefactorselementget(element_number, &
1123  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR,err,error,*999)
1124  nhs=0
1125  ! Loop over element columns
1126  DO nh=1,number_of_dimensions
1127  DO ns=1,number_of_element_parameters(nh)
1128  nhs=nhs+1
1129  mhs=nhs-1
1130  ! Loop over element rows
1131  DO ms=ns,number_of_element_parameters(nh)
1132  mhs=mhs+1
1133  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)* &
1134  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,nh)* &
1135  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1136  ENDDO !ms
1137  ENDDO !ns
1138  ENDDO !nh
1139  DO oh=1,off_diag_comp(number_of_dimensions)
1140  nh=off_diag_dep_var1(oh)
1141  mh=off_diag_dep_var2(oh)
1142  nhs=element_base_dof_index(nh)
1143  DO ns=1,number_of_element_parameters(nh)
1144  nhs=nhs+1
1145  mhs=element_base_dof_index(mh)
1146  !Loop over element rows belonging to geometric dependent variables
1147  DO ms=1,number_of_element_parameters(mh)
1148  mhs=mhs+1
1149  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)* &
1150  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
1151  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1152  ENDDO !ms
1153  ENDDO !ns
1154  ENDDO
1155 
1156  nhs=0
1157  IF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN !node based
1158  !Loop over element rows belonging to geometric dependent variables
1159  DO nh=1,number_of_dimensions
1160  DO ns=1,number_of_element_parameters(nh)
1161  nhs=nhs+1
1162  !Loop over element rows belonging to hydrostatic pressure
1163  mhs=element_base_dof_index(pressure_component)
1164  DO ms=1,number_of_element_parameters(pressure_component)
1165  mhs=mhs+1
1166  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(nhs,mhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(nhs,mhs)* &
1167  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR% &
1168  & scale_factors(ms,pressure_component)* &
1169  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1170  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)* &
1171  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR% &
1172  & scale_factors(ms,pressure_component)* &
1173  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1174  ENDDO !ms
1175  ENDDO !ns
1176  ENDDO !nh
1177  ELSEIF(field_variable%COMPONENTS(pressure_component)%INTERPOLATION_TYPE==field_element_based_interpolation) THEN !element based
1178  !Loop over element rows belonging to geometric dependent variables
1179  DO nh=1,number_of_dimensions
1180  DO ns=1,number_of_element_parameters(nh)
1181  nhs=nhs+1
1182  !Loop over element rows belonging to hydrostatic pressure
1183  mhs=element_base_dof_index(pressure_component)+1
1184  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)* &
1185  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1186  ENDDO !ns
1187  ENDDO !nh
1188  ENDIF
1189  ENDIF
1190 
1191  !Mirror the Jacobian matrix except for the hydrostatic rows and columns, which are not necessarily symmetric.
1192  DO nhs=2,element_base_dof_index(pressure_component)
1193  DO mhs=1,nhs-1
1194  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(nhs,mhs)
1195  ENDDO !mhs
1196  ENDDO !nhs
1197 
1198  !If unsymmetric pressure Jacobian uncomment this.
1199  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
1200  IF(dependent_field%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
1201  & total_number_of_surface_pressure_conditions>0) THEN !
1202  CALL finiteelasticity_surfacepressurejacobianevaluate(equations_set,element_number,err,error,*999)
1203  ENDIF
1204  ENDIF
1205  ELSE
1206  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1207  ENDIF
1208  ELSE
1209  CALL flagerror("Equations set is not associated.",err,error,*999)
1210  ENDIF
1211 
1212  exits("FiniteElasticity_FiniteElementJacobianEvaluate")
1213  RETURN
1214 999 errors("FiniteElasticity_FiniteElementJacobianEvaluate",err,error)
1215  exits("FiniteElasticity_FiniteElementJacobianEvaluate")
1216  RETURN 1
1217 
1218  END SUBROUTINE finiteelasticity_finiteelementjacobianevaluate
1219 
1220  !
1221  !================================================================================================================================
1222  !
1223 
1225  SUBROUTINE finite_elasticity_push_elasticity_tensor(ELASTICITY_TENSOR,DZDNU,Jznu,ERR,ERROR,*)
1226 
1227  !Argument variables
1228  REAL(DP), INTENT(INOUT) :: ELASTICITY_TENSOR(6,6)
1229  REAL(DP), INTENT(IN) :: DZDNU(3,3)
1230  REAL(DP), INTENT(IN) :: Jznu
1231  INTEGER(INTG), INTENT(OUT) :: ERR
1232  TYPE(varying_string), INTENT(OUT) :: ERROR
1233  !Local Variables
1234  INTEGER(INTG) :: i,j
1235  REAL(DP) :: t(6,6)
1236 
1237  enters("FINITE_ELASTICITY_PUSH_ELASTICITY_TENSOR",err,error,*999)
1238 
1239  DO j=1,3
1240  DO i=1,6
1241  t(i,j)=dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(1,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(2,j))
1242  ENDDO
1243  END DO
1244  DO j=4,6
1245  DO i=1,6
1246  t(i,j)=dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(1,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(2,j))+ &
1247  & dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(2,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(1,j))
1248  ENDDO
1249  END DO
1250 
1251  elasticity_tensor=matmul(matmul(t,elasticity_tensor),transpose(t))/jznu
1252 
1253  exits("FINITE_ELASTICITY_PUSH_ELASTICITY_TENSOR")
1254  RETURN
1255 999 errorsexits("FINITE_ELASTICITY_PUSH_ELASTICITY_TENSOR",err,error)
1256  RETURN 1
1257  END SUBROUTINE finite_elasticity_push_elasticity_tensor
1258 
1259  !
1260  !================================================================================================================================
1261  !
1262 
1264  SUBROUTINE finite_elasticity_push_stress_tensor(STRESS_TENSOR,DZDNU,Jznu,ERR,ERROR,*)
1265 
1266  !Argument variables
1267  REAL(DP), INTENT(INOUT) :: STRESS_TENSOR(6)
1268  REAL(DP), INTENT(IN) :: DZDNU(3,3)
1269  REAL(DP), INTENT(IN) :: Jznu
1270  INTEGER(INTG), INTENT(OUT) :: ERR
1271  TYPE(varying_string), INTENT(OUT) :: ERROR
1272  !Local Variables
1273  INTEGER(INTG) :: i,j
1274  REAL(DP) :: t(6,6)
1275 
1276  enters("FINITE_ELASTICITY_PUSH_STRESS_TENSOR",err,error,*999)
1277 
1278  DO j=1,3
1279  DO i=1,6
1280  t(i,j)=dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(1,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(2,j))
1281  ENDDO
1282  END DO
1283  DO j=4,6
1284  DO i=1,6
1285  t(i,j)=dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(1,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(2,j))+ &
1286  & dzdnu(voigt_to_tensor3(1,i),voigt_to_tensor3(2,j))*dzdnu(voigt_to_tensor3(2,i),voigt_to_tensor3(1,j))
1287  ENDDO
1288  END DO
1289 
1290  stress_tensor=matmul(t,stress_tensor)/jznu
1291 
1292  exits("FINITE_ELASTICITY_PUSH_STRESS_TENSOR")
1293  RETURN
1294 999 errorsexits("FINITE_ELASTICITY_PUSH_STRESS_TENSOR",err,error)
1295  RETURN 1
1296  END SUBROUTINE finite_elasticity_push_stress_tensor
1297 
1298  !
1299  !================================================================================================================================
1300  !
1301 
1303  SUBROUTINE finiteelasticity_gaussgrowthtensor(equationsSet,numberOfDimensions,gaussPointNumber,elementNumber,dependentField, &
1304  & deformationgradienttensor,growthtensor,elasticdeformationgradienttensor,jg,je,err,error,*)
1305 
1306  !Argument variables
1307  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
1308  INTEGER(INTG), INTENT(IN) :: numberOfDimensions
1309  INTEGER(INTG), INTENT(IN) :: gaussPointNumber
1310  INTEGER(INTG), INTENT(IN) :: elementNumber
1311  TYPE(field_type), POINTER :: dependentField
1312  REAL(DP), INTENT(IN) :: deformationGradientTensor(3,3)
1313  REAL(DP), INTENT(OUT) :: growthTensor(3,3)
1314  REAL(DP), INTENT(OUT) :: elasticDeformationGradientTensor(3,3)
1315  REAL(DP), INTENT(OUT) :: Jg
1316  REAL(DP), INTENT(OUT) :: Je
1317  INTEGER(INTG), INTENT(OUT) :: err
1318  TYPE(varying_string), INTENT(OUT) :: error
1319  !Local Variables
1320  REAL(DP) :: growthTensorInverse(3,3),J
1321 
1322  enters("FiniteElasticity_GaussGrowthTensor",err,error,*999)
1323 
1324  IF(ASSOCIATED(equationsset)) THEN
1325  CALL identitymatrix(growthtensor,err,error,*999)
1326  jg=1.0_dp
1327  elasticdeformationgradienttensor=deformationgradienttensor
1328  je=determinant(elasticdeformationgradienttensor,err,error)
1329  ELSE
1330  CALL flagerror("Equations set is not associated.",err,error,*999)
1331  ENDIF
1332 
1333  IF(diagnostics1) THEN
1334  CALL writestring(diagnostic_output_type,"",err,error,*999)
1335  CALL writestring(diagnostic_output_type,"Growth information:",err,error,*999)
1336  CALL writestring(diagnostic_output_type," Total deformation gradient tensor:",err,error,*999)
1337  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,deformationgradienttensor, &
1338  & write_string_matrix_name_and_indices,'(" F','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
1339  j=determinant(deformationgradienttensor,err,error)
1340  CALL writestringvalue(diagnostic_output_type," Determinant F, J = ",j,err,error,*999)
1341  CALL writestring(diagnostic_output_type," Elastic component of the deformation gradient tensor:",err,error,*999)
1342  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,elasticdeformationgradienttensor, &
1343  & write_string_matrix_name_and_indices,'(" Fe','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
1344  CALL writestringvalue(diagnostic_output_type," Determinant Fe, Je = ",je,err,error,*999)
1345  CALL writestring(diagnostic_output_type," Growth component of the deformation gradient tensor:",err,error,*999)
1346  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,growthtensor, &
1347  & write_string_matrix_name_and_indices,'(" Fg','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
1348  CALL writestringvalue(diagnostic_output_type," Determinant Fg, Jg = ",jg,err,error,*999)
1349  ENDIF
1350 
1351  exits("FiniteElasticity_GaussGrowthTensor")
1352  RETURN
1353  999 errorsexits("FiniteElasticity_GaussGrowthTensor",err,error)
1354  RETURN 1
1355 
1356  END SUBROUTINE finiteelasticity_gaussgrowthtensor
1357 
1358  !
1359  !================================================================================================================================
1360  !
1361 
1363  SUBROUTINE finiteelasticity_straintensor(deformationGradientTensor,rightCauchyDeformationTensor,fingerDeformationTensor, &
1364  jacobian,greenstraintensor,err,error,*)
1365 
1366  !Argument variables
1367  REAL(DP), INTENT(IN) :: deformationGradientTensor(3,3)
1368  REAL(DP) :: deformationGradientTensorT(3,3)
1369  REAL(DP), INTENT(OUT) :: rightCauchyDeformationTensor(3,3)
1370  REAL(DP), INTENT(OUT) :: fingerDeformationTensor(3,3)
1371  REAL(DP), INTENT(OUT) :: Jacobian
1372  REAL(DP), INTENT(OUT) :: greenStrainTensor(3,3)
1373  INTEGER(INTG), INTENT(OUT) :: err
1374  TYPE(varying_string), INTENT(OUT) :: error
1375  !Local Variables
1376  INTEGER(INTG) :: i
1377  REAL(DP) :: I3
1378 
1379  enters("FiniteElasticity_StrainTensor",err,error,*999)
1380 
1381  CALL matrixtranspose(deformationgradienttensor, deformationgradienttensort,err,error,*999)
1382  CALL matrixproduct(deformationgradienttensort, deformationgradienttensor, rightcauchydeformationtensor,err,error,*999)
1383  !CALL MatrixTransposeProduct(deformationGradientTensor,deformationGradientTensor,rightCauchyDeformationTensor,err,error,*999)
1384  CALL invert(rightcauchydeformationtensor,fingerdeformationtensor,i3,err,error,*999)
1385  jacobian=determinant(deformationgradienttensor,err,error)
1386 
1387  greenstraintensor=0.5_dp*rightcauchydeformationtensor
1388  DO i=1,3
1389  greenstraintensor(i,i)=greenstraintensor(i,i)-0.5_dp
1390  ENDDO !i
1391 
1392  IF(diagnostics1) THEN
1393  CALL writestring(diagnostic_output_type,"",err,error,*999)
1394  CALL writestring(diagnostic_output_type,"Strain information:",err,error,*999)
1395  CALL writestring(diagnostic_output_type," Right Cauchy-Green deformation tensor:",err,error,*999)
1396  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
1397  & 3,3,rightcauchydeformationtensor,write_string_matrix_name_and_indices, '(" C','(",I1,",:)', &
1398  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
1399  CALL writestring(diagnostic_output_type," Finger deformation tensor:",err,error,*999)
1400  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
1401  & 3,3,fingerdeformationtensor,write_string_matrix_name_and_indices, '(" f','(",I1,",:)', &
1402  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
1403  CALL writestringvalue(diagnostic_output_type," Jacobian = ",jacobian,err,error,*999)
1404  CALL writestring(diagnostic_output_type," Green-Lagrange strain tensor:",err,error,*999)
1405  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
1406  & 3,3,greenstraintensor,write_string_matrix_name_and_indices, '(" E','(",I1,",:)', &
1407  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
1408  ENDIF
1409 
1410  exits("FiniteElasticity_StrainTensor")
1411  RETURN
1412  999 errorsexits("FiniteElasticity_StrainTensor",err,error)
1413  RETURN 1
1414 
1415  END SUBROUTINE finiteelasticity_straintensor
1416 
1417  !
1418  !================================================================================================================================
1419  !
1420 
1422  SUBROUTINE finiteelasticity_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
1423 
1424  !Argument variables
1425  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1426  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
1427  INTEGER(INTG), INTENT(OUT) :: ERR
1428  TYPE(varying_string), INTENT(OUT) :: ERROR
1429  !Local Variables
1430  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,COMPONENT_BASIS
1431  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
1432  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
1433  TYPE(equations_type), POINTER :: EQUATIONS
1434  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1435  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1436  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
1437  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
1438  TYPE(field_type), POINTER :: DEPENDENT_FIELD,FIBRE_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,EQUATIONS_SET_FIELD,SOURCE_FIELD
1439  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
1440  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
1441  TYPE(quadrature_scheme_type), POINTER :: DEPENDENT_QUADRATURE_SCHEME,COMPONENT_QUADRATURE_SCHEME
1442  TYPE(field_interpolation_parameters_type), POINTER :: GEOMETRIC_INTERPOLATION_PARAMETERS, &
1443  & FIBRE_INTERPOLATION_PARAMETERS,MATERIALS_INTERPOLATION_PARAMETERS,DEPENDENT_INTERPOLATION_PARAMETERS, &
1444  & DARCY_DEPENDENT_INTERPOLATION_PARAMETERS,SOURCE_INTERPOLATION_PARAMETERS,DARCY_MATERIALS_INTERPOLATION_PARAMETERS, &
1445  & DENSITY_INTERPOLATION_PARAMETERS,INDEPENDENT_INTERPOLATION_PARAMETERS
1446  TYPE(field_interpolated_point_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT,FIBRE_INTERPOLATED_POINT, &
1447  & MATERIALS_INTERPOLATED_POINT,DEPENDENT_INTERPOLATED_POINT,DARCY_DEPENDENT_INTERPOLATED_POINT,SOURCE_INTERPOLATED_POINT, &
1448  & DENSITY_INTERPOLATED_POINT,INDEPENDENT_INTERPOLATED_POINT,DARCY_MATERIALS_INTERPOLATED_POINT
1449  TYPE(field_interpolated_point_metrics_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT_METRICS, &
1450  & DEPENDENT_INTERPOLATED_POINT_METRICS
1451  TYPE(basis_type), POINTER :: DEPENDENT_BASIS_1,GEOMETRIC_BASIS
1452  TYPE(decomposition_type), POINTER :: DECOMPOSITION
1453  TYPE(domain_mapping_type), POINTER :: DOMAIN_ELEMENT_MAPPING
1454  TYPE(varying_string) :: LOCAL_ERROR
1455  LOGICAL :: DARCY_DENSITY,DARCY_DEPENDENT
1456  INTEGER(INTG) :: component_idx,component_idx2,parameter_idx,gauss_idx,element_dof_idx,FIELD_VAR_TYPE,DARCY_FIELD_VAR_TYPE
1457  INTEGER(INTG) :: imatrix,Ncompartments
1458  INTEGER(INTG) :: i,j,numberOfXDimensions,numberOfXiDimensions
1459  INTEGER(INTG) :: NDOFS,mh,ms,mhs,mi,nh,ns
1460  INTEGER(INTG) :: DEPENDENT_NUMBER_OF_COMPONENTS
1461  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NUMBER_OF_XI,HYDROSTATIC_PRESSURE_COMPONENT
1462  INTEGER(INTG) :: NUMBER_OF_FIELD_COMPONENT_INTERPOLATION_PARAMETERS
1463  INTEGER(INTG) :: DEPENDENT_COMPONENT_INTERPOLATION_TYPE
1464  INTEGER(INTG) :: DEPENDENT_NUMBER_OF_GAUSS_POINTS
1465  INTEGER(INTG) :: MESH_COMPONENT_1,MESH_COMPONENT_NUMBER
1466  INTEGER(INTG) :: TOTAL_NUMBER_OF_SURFACE_PRESSURE_CONDITIONS
1467  INTEGER(INTG) :: var1 ! Variable number corresponding to 'U' in single physics case
1468  INTEGER(INTG) :: var2 ! Variable number corresponding to 'DELUDLEN' in single physics case
1469  INTEGER(INTG), POINTER :: EQUATIONS_SET_FIELD_DATA(:)
1470  REAL(DP) :: DZDNU(3,3),DZDNUT(3,3),AZL(3,3),AZU(3,3),Fe(3,3),FeT(3,3),Fg(3,3),C(3,3),f(3,3),E(3,3),I3,P, &
1471  & piolaTensor(3,3),TEMP(3,3)
1472  REAL(DP) :: cauchyTensor(3,3),JGW_CAUCHY_TENSOR(3,3),kirchoffTensor(3,3),STRESS_TENSOR(6)
1473  REAL(DP) :: deformationGradientTensor(3,3),growthTensor(3,3),growthTensorInverse(3,3),growthTensorInverseTranspose(3,3), &
1474  & fibreGrowth,sheetGrowth,normalGrowth,fibreVector(3),sheetVector(3),normalVector(3)
1475  REAL(DP) :: dNudXi(3,3),dXidNu(3,3)
1476  REAL(DP) :: DFDZ(64,3,3) !temporary until a proper alternative is found
1477  REAL(DP) :: DPHIDZ(3,64,3) !temporary until a proper alternative is found
1478  REAL(DP) :: GAUSS_WEIGHT,Jznu,Jxxi,Jzxi,Je,Jg,JGW
1479  REAL(DP) :: SUM1,TEMPTERM1
1480  REAL(DP) :: THICKNESS ! for elastic membrane
1481  REAL(DP) :: DARCY_MASS_INCREASE,DARCY_VOL_INCREASE,DARCY_RHO_0_F,DENSITY !coupling with Darcy model
1482  REAL(DP) :: Mfact, bfact, p0fact
1483  INTEGER(INTG) :: EQUATIONS_SET_SUBTYPE
1484 
1485  enters("FiniteElasticity_FiniteElementResidualEvaluate",err,error,*999)
1486 
1487  NULLIFY(boundary_conditions,boundary_conditions_variable)
1488  NULLIFY(dependent_basis,component_basis)
1489  NULLIFY(equations,equations_mapping,equations_matrices,nonlinear_matrices,rhs_vector)
1490  NULLIFY(dependent_field,fibre_field,geometric_field,materials_field,source_field,independent_field)
1491  NULLIFY(field_variable)
1492  NULLIFY(dependent_quadrature_scheme,component_quadrature_scheme)
1493  NULLIFY(geometric_interpolation_parameters,fibre_interpolation_parameters,source_interpolation_parameters)
1494  NULLIFY(materials_interpolation_parameters,dependent_interpolation_parameters)
1495  NULLIFY(independent_interpolation_parameters,darcy_materials_interpolation_parameters)
1496  NULLIFY(darcy_dependent_interpolation_parameters,density_interpolation_parameters)
1497  NULLIFY(geometric_interpolated_point,fibre_interpolated_point,source_interpolated_point)
1498  NULLIFY(geometric_interpolated_point_metrics,dependent_interpolated_point_metrics)
1499  NULLIFY(materials_interpolated_point,dependent_interpolated_point,darcy_dependent_interpolated_point)
1500  NULLIFY(density_interpolated_point,independent_interpolated_point)
1501  NULLIFY(dependent_basis_1)
1502  NULLIFY(decomposition)
1503  NULLIFY(equations_set_field_data)
1504 
1505  IF(ASSOCIATED(equations_set)) THEN
1506  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1507  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1508  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1509  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
1510  & err,error,*999)
1511  END IF
1512  equations_set_subtype = equations_set%SPECIFICATION(3)
1513  equations=>equations_set%EQUATIONS
1514  IF(ASSOCIATED(equations)) THEN
1515  !Which variables are we working with - find the variable pair used for this equations set
1516  !\todo: put in checks for all the objects/mappings below (do we want to do this for every element?)
1517  var1=equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR%VARIABLE_NUMBER ! number for 'U'
1518  var2=equations%EQUATIONS_MAPPING%RHS_MAPPING%RHS_VARIABLE%VARIABLE_NUMBER ! number for 'DELUDELN'
1519 
1520  !Grab pointers: matrices, fields, decomposition, basis
1521  !\todo: see if we can separate this residual evaluation from the pressure boundary conditions somehow
1522  !so that the equations set doesn't need to maintain a pointer to the boundary conditions
1523  boundary_conditions=>equations_set%BOUNDARY_CONDITIONS
1524  CALL boundary_conditions_variable_get(boundary_conditions,equations_set%EQUATIONS%EQUATIONS_MAPPING%RHS_MAPPING% &
1525  & rhs_variable,boundary_conditions_variable,err,error,*999)
1526  total_number_of_surface_pressure_conditions=boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure)+ &
1527  & boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure_incremented)
1528 
1529  equations_matrices=>equations%EQUATIONS_MATRICES
1530  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
1531  rhs_vector=>equations_matrices%RHS_VECTOR
1532  equations_mapping =>equations%EQUATIONS_MAPPING
1533 
1534  fibre_field =>equations%INTERPOLATION%FIBRE_FIELD
1535  geometric_field =>equations%INTERPOLATION%GEOMETRIC_FIELD
1536  materials_field =>equations%INTERPOLATION%MATERIALS_FIELD
1537  dependent_field =>equations%INTERPOLATION%DEPENDENT_FIELD
1538  source_field =>equations%INTERPOLATION%SOURCE_FIELD
1539  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
1540 
1541  decomposition =>dependent_field%DECOMPOSITION
1542  mesh_component_number = decomposition%MESH_COMPONENT_NUMBER
1543 
1544  domain_element_mapping=>decomposition%DOMAIN(1)%PTR%MAPPINGS%ELEMENTS
1545 
1546  dependent_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BASIS
1547  dependent_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1548  dependent_number_of_gauss_points=dependent_quadrature_scheme%NUMBER_OF_GAUSS
1549  dependent_number_of_components=dependent_field%VARIABLES(var1)%NUMBER_OF_COMPONENTS
1550  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1551  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1552 
1553  number_of_dimensions=equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
1554  number_of_xi=decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BASIS%NUMBER_OF_XI
1555 
1556  !Initialise tensors and matrices
1557  CALL identitymatrix(dzdnu,err,error,*999)
1558  CALL identitymatrix(piolatensor,err,error,*999)
1559  CALL identitymatrix(cauchytensor,err,error,*999)
1560  dfdz=0.0_dp ! (parameter_idx,component_idx)
1561 
1562  !Set flags for coupled finite elasticity and Darcy problems
1563  !Check if we need Darcy materials field for Density
1564  IF(equations_set_subtype==equations_set_elasticity_fluid_pressure_static_inria_subtype .OR. &
1565  & equations_set_subtype==equations_set_elasticity_fluid_pressure_holmes_mow_subtype .OR. &
1566  & equations_set_subtype==equations_set_elasticity_fluid_pres_holmes_mow_active_subtype) THEN
1567  darcy_density=.true.
1568  ELSE
1569  darcy_density=.false.
1570  ENDIF
1571  !Check if we need Darcy dependent field
1572  IF(equations_set_subtype==equations_set_incompressible_finite_elasticity_darcy_subtype .OR. &
1573  & equations_set_subtype==equations_set_elasticity_darcy_inria_model_subtype .OR. &
1574  & equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype .OR. &
1575  & equations_set_subtype==equations_set_elasticity_fluid_pressure_static_inria_subtype .OR. &
1576  & equations_set_subtype==equations_set_elasticity_fluid_pressure_holmes_mow_subtype .OR. &
1577  & equations_set_subtype==equations_set_elasticity_fluid_pres_holmes_mow_active_subtype) THEN
1578  darcy_dependent=.true.
1579  ELSE
1580  darcy_dependent=.false.
1581  ENDIF
1582 
1583  !Grab interpolation parameters
1584  field_variable=>equations_set%EQUATIONS%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
1585  field_var_type=field_variable%VARIABLE_TYPE
1586  dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR
1587  geometric_interpolation_parameters=>equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%PTR
1588  IF(ASSOCIATED(fibre_field)) THEN
1589  fibre_interpolation_parameters=>equations%INTERPOLATION%FIBRE_INTERP_PARAMETERS(field_u_variable_type)%PTR
1590  ENDIF
1591  IF(ASSOCIATED(materials_field)) THEN
1592  materials_interpolation_parameters=>equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS(field_u_variable_type)%PTR
1593 ! DENSITY_INTERPOLATION_PARAMETERS=>EQUATIONS%INTERPOLATION%MATERIALS_INTERP_PARAMETERS(FIELD_V_VARIABLE_TYPE)%PTR
1594  ENDIF
1595  IF(darcy_dependent) THEN
1596  darcy_dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_v_variable_type)%PTR
1597  ELSE IF(equations_set_subtype==equations_set_standard_monodomain_elasticity_subtype) THEN
1598  independent_interpolation_parameters=>equations%INTERPOLATION%INDEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR
1599  ENDIF
1600 ! IF(ASSOCIATED(SOURCE_FIELD)) THEN
1601 ! SOURCE_INTERPOLATION_PARAMETERS=>EQUATIONS%INTERPOLATION%SOURCE_INTERP_PARAMETERS(FIELD_U_VARIABLE_TYPE)%PTR
1602 ! ENDIF
1603 
1604  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1605  & geometric_interpolation_parameters,err,error,*999)
1606  IF(ASSOCIATED(fibre_field)) THEN
1607  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1608  & fibre_interpolation_parameters,err,error,*999)
1609  END IF
1610  IF(ASSOCIATED(materials_field)) THEN
1611  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1612  & materials_interpolation_parameters,err,error,*999)
1613 ! IF(ASSOCIATED(DENSITY_INTERPOLATION_PARAMETERS)) THEN
1614 ! CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, &
1615 ! & DENSITY_INTERPOLATION_PARAMETERS,ERR,ERROR,*999)
1616 ! ENDIF
1617  ENDIF
1618  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1619  & dependent_interpolation_parameters,err,error,*999)
1620  IF(darcy_dependent) THEN
1621  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1622  & darcy_dependent_interpolation_parameters,err,error,*999)
1623  ELSE IF(equations_set_subtype==equations_set_standard_monodomain_elasticity_subtype) THEN
1624  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1625  & independent_interpolation_parameters,err,error,*999)
1626  ENDIF
1627 ! IF(ASSOCIATED(SOURCE_FIELD)) THEN
1628 ! CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, &
1629 ! & SOURCE_INTERPOLATION_PARAMETERS,ERR,ERROR,*999)
1630 ! END IF
1631 
1632  !Point interpolation pointer
1633  geometric_interpolated_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
1634  geometric_interpolated_point_metrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
1635  IF(ASSOCIATED(fibre_field)) THEN
1636  fibre_interpolated_point=>equations%INTERPOLATION%FIBRE_INTERP_POINT(field_u_variable_type)%PTR
1637  END IF
1638  IF(ASSOCIATED(materials_field)) THEN
1639  materials_interpolated_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR
1640  density_interpolated_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR
1641  ENDIF
1642  dependent_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR
1643  dependent_interpolated_point_metrics=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS(field_var_type)%PTR
1644  IF(darcy_dependent) THEN
1645  darcy_dependent_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_v_variable_type)%PTR
1646  ELSE IF(equations_set_subtype==equations_set_standard_monodomain_elasticity_subtype) THEN
1647  independent_interpolated_point=>equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR
1648  ENDIF
1649  IF(ASSOCIATED(source_field)) THEN
1650  source_interpolated_point=>equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR
1651  ENDIF
1652 
1653  !SELECT: Compressible or incompressible cases, or poro multicompartment
1654  SELECT CASE(equations_set_subtype)
1655  ! ---------------------------------------------------------------
1656  CASE(equations_set_mooney_rivlin_activecontraction_subtype,equations_set_mooney_rivlin_subtype)
1657 ! CASE(EQUATIONS_SET_MOONEY_RIVLIN_ACTIVECONTRACTION_SUBTYPE,EQUATIONS_SET_MOONEY_RIVLIN_SUBTYPE, &
1658 ! & EQUATIONS_SET_TRANSVERSE_ISOTROPIC_GUCCIONE_SUBTYPE,EQUATIONS_SET_GUCCIONE_ACTIVECONTRACTION_SUBTYPE) ! 4 dependent components
1659  !Loop over gauss points and add residuals
1660  DO gauss_idx=1,dependent_number_of_gauss_points
1661  !Interpolate dependent, geometric, fibre and materials fields
1662  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1663  & dependent_interpolated_point,err,error,*999)
1664  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI,dependent_interpolated_point_metrics, &
1665  & err,error,*999)
1666  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1667  & geometric_interpolated_point,err,error,*999)
1668  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,geometric_interpolated_point_metrics, &
1669  & err,error,*999)
1670  IF(ASSOCIATED(fibre_field)) THEN
1671  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1672  & fibre_interpolated_point,err,error,*999)
1673  END IF
1674  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1675  & materials_interpolated_point,err,error,*999)
1676 
1677  !Loop over geometric dependent basis functions.
1678  DO nh=1,number_of_dimensions
1679  mesh_component_number=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
1680  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
1681  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1682  component_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1683  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1684  !Loop over derivative directions.
1685  DO mh=1,number_of_dimensions
1686  sum1=0.0_dp
1687  DO mi=1,number_of_xi
1688  sum1=sum1+dependent_interpolated_point_metrics%DXI_DX(mi,mh)* &
1689  & component_quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(mi),gauss_idx)
1690  ENDDO !mi
1691  dphidz(mh,ns,nh)=sum1
1692  ENDDO !mh
1693  ENDDO !ns
1694  ENDDO !nh
1695 
1696  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
1697  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
1698 
1699  jznu=dependent_interpolated_point_metrics%JACOBIAN/geometric_interpolated_point_metrics%JACOBIAN
1700  jgw=dependent_interpolated_point_metrics%JACOBIAN*dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
1701 
1702  !Calculate the Cauchy stress tensor (in Voigt form) at the gauss point.
1703  CALL finite_elasticity_gauss_stress_tensor(equations_set,dependent_interpolated_point, &
1704  & materials_interpolated_point,stress_tensor,dzdnu,jznu,element_number,gauss_idx,err,error,*999)
1705 
1706  ! Convert from Voigt form to tensor form and multiply with Jacobian and Gauss weight.
1707  DO nh=1,number_of_dimensions
1708  DO mh=1,number_of_dimensions
1709  jgw_cauchy_tensor(mh,nh)=jgw*stress_tensor(tensor_to_voigt3(mh,nh))
1710  ENDDO
1711  ENDDO
1712 
1713  !Now add up the residual terms
1714  mhs=0
1715  DO mh=1,number_of_dimensions
1716  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1717  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
1718  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1719  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1720  mhs=mhs+1
1721  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ &
1722  & dot_product(dphidz(:,ms,mh),jgw_cauchy_tensor(:,mh))
1723  ENDDO !ms
1724  ENDDO !mh
1725 
1726  jgw=geometric_interpolated_point_metrics%JACOBIAN*dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
1727 
1728  !Hydrostatic pressure component
1729  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1730  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
1731  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1732  component_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1733  tempterm1=jgw*(jznu-1.0_dp)
1734  IF(field_variable%COMPONENTS(mh)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN !node based
1735  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1736  mhs=mhs+1
1737  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ &
1738  & tempterm1*component_quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,gauss_idx)
1739  ENDDO
1740  ELSEIF(field_variable%COMPONENTS(mh)%INTERPOLATION_TYPE==field_element_based_interpolation) THEN !element based
1741  mhs=mhs+1
1742  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+tempterm1
1743  ENDIF
1744 
1745 ! !Gravity loading term
1746 ! IF(RHS_VECTOR%UPDATE_VECTOR) THEN
1747 ! IF(ASSOCIATED(SOURCE_FIELD)) THEN
1748 ! CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,gauss_idx, &
1749 ! & SOURCE_INTERPOLATED_POINT,ERR,ERROR,*999)
1750 ! IF(ASSOCIATED(DENSITY_INTERPOLATED_POINT)) THEN
1751 ! CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,gauss_idx, &
1752 ! & DENSITY_INTERPOLATED_POINT,ERR,ERROR,*999)
1753 ! DENSITY=DENSITY_INTERPOLATED_POINT%VALUES(1,NO_PART_DERIV)
1754 ! mhs=0
1755 ! DO mh=1,NUMBER_OF_DIMENSIONS
1756 ! MESH_COMPONENT_NUMBER=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1757 ! DEPENDENT_BASIS=>DEPENDENT_FIELD%DECOMPOSITION%DOMAIN(MESH_COMPONENT_NUMBER)%PTR% &
1758 ! & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS
1759 ! COMPONENT_QUADRATURE_SCHEME=>DEPENDENT_BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP( &
1760 ! & BASIS_DEFAULT_QUADRATURE_SCHEME)%PTR
1761 ! G_DENSITY_JGW=SOURCE_INTERPOLATED_POINT%VALUES(mh,NO_PART_DERIV)*DENSITY*JGW
1762 ! DO ms=1,DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS
1763 ! mhs=mhs+1
1764 ! RHS_VECTOR%ELEMENT_VECTOR%VECTOR(mhs)=RHS_VECTOR%ELEMENT_VECTOR%VECTOR(mhs)+ &
1765 ! & G_DENSITY_JGW*COMPONENT_QUADRATURE_SCHEME%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,gauss_idx)
1766 ! ENDDO
1767 ! ENDDO
1768 ! ENDIF
1769 ! ENDIF
1770 ! ENDIF
1771  ENDDO !gauss_idx
1772 
1773 
1774  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
1775  IF(decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
1776  & total_number_of_surface_pressure_conditions>0) THEN !
1777  CALL finiteelasticity_surfacepressureresidualevaluate(equations_set,element_number,var1,var2,err,error,*999)
1778  ENDIF
1779 
1780  !Scale factor adjustment
1781  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
1782  ! Following function is necessary, otherwise wrong face scale factors from function call to surface pressure residual are
1783  ! used.
1784  CALL field_interpolationparametersscalefactorselementget(element_number, &
1785  & dependent_interpolation_parameters,err,error,*999)
1786  mhs=0
1787  DO mh=1,number_of_dimensions
1788  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1789  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
1790  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1791  !Loop over residual vector
1792  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1793  mhs=mhs+1
1794  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)* &
1795  & dependent_interpolation_parameters%SCALE_FACTORS(ms,mh)
1796  ENDDO !ms
1797  ENDDO !mh
1798  IF(field_variable%COMPONENTS(mh)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN !node based
1799  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1800  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
1801  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1802  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1803  mhs=mhs+1
1804  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)* &
1805  & dependent_interpolation_parameters%SCALE_FACTORS(ms,mh)
1806  ENDDO
1807  ENDIF
1808  ENDIF
1809 
1810  ! ---------------------------------------------------------------
1811  CASE(equations_set_no_subtype,equations_set_membrane_subtype, &
1812  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
1813  & equations_set_isotropic_exponential_subtype, &
1814  & equations_set_transverse_isotropic_exponential_subtype, &
1815  & equations_set_transverse_isotropic_guccione_subtype,equations_set_guccione_activecontraction_subtype, &
1816  & equations_set_orthotropic_material_costa_subtype, equations_set_activecontraction_subtype, &
1817  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_standard_monodomain_elasticity_subtype, &
1818  & equations_set_orthotropic_material_holzapfel_ogden_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
1819  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
1820  & equations_set_active_strain_subtype,equations_set_multiscale_active_strain_subtype, &
1821  & equations_set_1d3d_monodomain_active_strain_subtype, &
1822  & equations_set_incompressible_elasticity_driven_darcy_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
1823  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
1824  & equations_set_transverse_isotropic_active_subtype,equations_set_trans_isotropic_active_transition_subtype, &
1825  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
1826  & equations_set_incompressible_mooney_rivlin_subtype, equations_set_holzapfel_ogden_activecontraction_subtype) ! 4 dependent components
1827 
1828  !Loop over gauss points and add residuals
1829  DO gauss_idx=1,dependent_number_of_gauss_points
1830  gauss_weight=dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
1831  !Interpolate dependent, geometric, fibre and materials fields
1832  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1833  & dependent_interpolated_point,err,error,*999)
1834  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI,dependent_interpolated_point_metrics, &
1835  & err,error,*999)
1836  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1837  & geometric_interpolated_point,err,error,*999)
1838  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,geometric_interpolated_point_metrics, &
1839  & err,error,*999)
1840  IF(ASSOCIATED(fibre_field)) THEN
1841  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1842  & fibre_interpolated_point,err,error,*999)
1843  END IF
1844  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1845  & materials_interpolated_point,err,error,*999)
1846  IF(darcy_dependent) THEN
1847  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1848  & darcy_dependent_interpolated_point,err,error,*999)
1849  ELSE IF(equations_set_subtype==equations_set_standard_monodomain_elasticity_subtype) THEN
1850  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1851  & independent_interpolated_point,err,error,*999)
1852  ENDIF
1853 
1854  !Calculate F=dZ/dNU, the deformation gradient tensor at the gauss point
1855  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
1856  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
1857  jznu=determinant(dzdnu,err,error)
1858  IF(jznu<0.0_dp) THEN
1859  local_error = "Warning: Volume is negative for gauss point "//trim(number_to_vstring(gauss_idx,"*",err,error))//&
1860  & " element "//trim(number_to_vstring(element_number,"*",err,error))
1861  CALL flagwarning(local_error,err,error,*999)
1862  local_error = "DET(F) = "//trim(number_to_vstring(jznu,"*",err,error))
1863  CALL flagwarning(local_error,err,error,*999)
1864  ENDIF
1865 
1866  jzxi=dependent_interpolated_point_metrics%JACOBIAN
1867  jxxi=geometric_interpolated_point_metrics%JACOBIAN
1868 
1869  IF(diagnostics1) THEN
1870  CALL write_string_value(diagnostic_output_type," ELEMENT_NUMBER = ",element_number,err,error,*999)
1871  CALL write_string_value(diagnostic_output_type," gauss_idx = ",gauss_idx,err,error,*999)
1872  ENDIF
1873 
1874  !Calculate Jacobian of deformation.
1875  CALL finiteelasticity_gaussgrowthtensor(equations_set,number_of_dimensions,gauss_idx,element_number,dependent_field, &
1876  & dzdnu,fg,fe,jg,je,err,error,*999)
1877 
1878  !Calculate strain tensors
1879  CALL finiteelasticity_straintensor(fe,c,f,jznu,e,err,error,*999)
1880 
1881  !Calculate Sigma=1/Jznu.FTF', the Cauchy stress tensor at the gauss point
1882  CALL finite_elasticity_gauss_cauchy_tensor(equations_set,dependent_interpolated_point, &
1883  & materials_interpolated_point,darcy_dependent_interpolated_point, &
1884  & independent_interpolated_point,cauchytensor,jznu,dzdnu,element_number,gauss_idx,err,error,*999)
1885 
1886  IF(diagnostics1) THEN
1887  CALL writestring(diagnostic_output_type,"",err,error,*999)
1888  CALL writestring(diagnostic_output_type,"Stress tensors:",err,error,*999)
1889  CALL writestringvalue(diagnostic_output_type," Hydrostatic pressure = ",p,err,error,*999)
1890  CALL writestring(diagnostic_output_type," Second Piola-Kirchoff stress tensor:",err,error,*999)
1891  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
1892  & 3,3,piolatensor,write_string_matrix_name_and_indices, '(" T','(",I1,",:)',' :",3(X,E13.6))', &
1893  & '(12X,3(X,E13.6))',err,error,*999)
1894  CALL writestring(diagnostic_output_type," Cauchy stress tensor:",err,error,*999)
1895  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
1896  & 3,3,cauchytensor,write_string_matrix_name_and_indices,'(" sigma','(",I1,",:)',' :",3(X,E13.6))', &
1897  & '(12X,3(X,E13.6))',err,error,*999)
1898  ENDIF
1899 
1900  IF(equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
1901  !Parameters settings for coupled elasticity Darcy INRIA model:
1902  CALL get_darcy_finite_elasticity_parameters(darcy_rho_0_f,mfact,bfact,p0fact,err,error,*999)
1903  darcy_mass_increase = darcy_dependent_interpolated_point%VALUES(4,no_part_deriv)
1904  darcy_vol_increase = darcy_mass_increase / darcy_rho_0_f
1905  ENDIF
1906 
1907  !For membrane theory in 3D space, the final equation is multiplied by thickness. Default to unit thickness if equation set subtype is not membrane
1908  thickness = 1.0_dp
1909  IF(equations_set_subtype == equations_set_membrane_subtype) THEN
1910  IF(number_of_dimensions == 3) THEN
1911  thickness = materials_interpolated_point%VALUES(materials_interpolated_point%INTERPOLATION_PARAMETERS% &
1912  & field_variable%NUMBER_OF_COMPONENTS,1)
1913  ENDIF
1914  ENDIF
1915 
1916  !Calculate the combined Jacobian
1917  jgw=jzxi*dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
1918 
1919  !Loop over geometric dependent basis functions and evaluate dPhidZ.
1920  DO nh=1,number_of_dimensions
1921  mesh_component_number=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
1922  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%ptr% &
1923  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1924  component_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%ptr
1925  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1926  !Loop over derivative directions.
1927  DO mh=1,number_of_dimensions
1928  sum1=0.0_dp
1929  DO mi=1,number_of_xi
1930  sum1=sum1+dependent_interpolated_point_metrics%DXI_DX(mi,mh)* &
1931  & component_quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(mi),gauss_idx)
1932  ENDDO !mi
1933  dphidz(mh,ns,nh)=sum1
1934  ENDDO !mh
1935  ENDDO !ns
1936  ENDDO !nh
1937 
1938  !Now add up the residual terms
1939  mhs=0
1940  DO mh=1,number_of_dimensions
1941  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1942  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%ptr% &
1943  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1944  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1945  mhs=mhs+1
1946  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ &
1947  & jgw*dot_product(dphidz(1:number_of_dimensions,ms,mh),cauchytensor(1:number_of_dimensions,mh))
1948  ENDDO !ms
1949  ENDDO !mh
1950 
1951  !Hydrostatic pressure component (skip for membrane problems)
1952  IF (equations_set_subtype /= equations_set_membrane_subtype) THEN
1953  hydrostatic_pressure_component=dependent_field%VARIABLES(var1)%NUMBER_OF_COMPONENTS
1954  dependent_component_interpolation_type=dependent_field%VARIABLES(var1)%COMPONENTS(hydrostatic_pressure_component)% &
1955  & interpolation_type
1956  IF(equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
1957  tempterm1=gauss_weight*(jzxi-(jg-darcy_vol_increase)*jxxi)
1958  ELSE
1959  tempterm1=gauss_weight*(jzxi/jxxi - 1.0_dp)*jxxi
1960  ENDIF
1961  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
1962  component_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(hydrostatic_pressure_component)%DOMAIN% &
1963  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1964  component_quadrature_scheme=>component_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%ptr
1965  number_of_field_component_interpolation_parameters=component_basis%NUMBER_OF_ELEMENT_PARAMETERS
1966  DO parameter_idx=1,number_of_field_component_interpolation_parameters
1967  mhs=mhs+1
1968  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ &
1969  & component_quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,1,gauss_idx)*tempterm1
1970  ENDDO
1971  ELSEIF(dependent_component_interpolation_type==field_element_based_interpolation) THEN !element based
1972  mhs=mhs+1
1973  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ tempterm1
1974  ENDIF
1975  ENDIF
1976  ENDDO !gauss_idx
1977 
1978  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
1979  IF(decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
1980  & total_number_of_surface_pressure_conditions>0) THEN !
1981  CALL finiteelasticity_surfacepressureresidualevaluate(equations_set,element_number,var1,var2,err,error,*999)
1982  ENDIF
1983 
1984  ! ---------------------------------------------------------------
1985  CASE(equations_set_constitutive_law_in_cellml_evaluate_subtype, &
1986  & equations_set_constitutive_and_growth_law_in_cellml_subtype)
1987 
1988  !Loop over gauss points and add residuals
1989  DO gauss_idx=1,dependent_number_of_gauss_points
1990 
1991  IF(diagnostics1) THEN
1992  CALL writestringvalue(diagnostic_output_type," Element number = ",element_number,err,error,*999)
1993  CALL writestringvalue(diagnostic_output_type," Gauss index = ",gauss_idx,err,error,*999)
1994  ENDIF
1995 
1996  gauss_weight=dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
1997  !Interpolate dependent, geometric, fibre and materials fields
1998  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
1999  & dependent_interpolated_point,err,error,*999)
2000  CALL field_interpolatedpointmetricscalculate(dependent_basis%NUMBER_OF_XI,dependent_interpolated_point_metrics, &
2001  & err,error,*999)
2002  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2003  & geometric_interpolated_point,err,error,*999)
2004  CALL field_interpolatedpointmetricscalculate(geometric_basis%NUMBER_OF_XI,geometric_interpolated_point_metrics, &
2005  & err,error,*999)
2006  IF(ASSOCIATED(fibre_field)) THEN
2007  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2008  & fibre_interpolated_point,err,error,*999)
2009  ENDIF
2010 
2011  !Calculate F=dZ/dNU, the deformation gradient tensor at the gauss point
2012  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
2013  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
2014 
2015  jxxi=geometric_interpolated_point_metrics%JACOBIAN
2016 
2017  jzxi=dependent_interpolated_point_metrics%JACOBIAN
2018 
2019  hydrostatic_pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE% &
2020  & number_of_components
2021  p=dependent_interpolated_point%VALUES(hydrostatic_pressure_component,1)
2022 
2023  CALL finiteelasticity_gaussgrowthtensor(equations_set,number_of_dimensions,gauss_idx,element_number,dependent_field, &
2024  & dzdnu,fg,fe,jg,je,err,error,*999)
2025 
2026  CALL finiteelasticity_straintensor(fe,c,f,jznu,e,err,error,*999)
2027 
2028  !Get the stress field!!!
2029  IF(number_of_dimensions==3) THEN
2030  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2031  & gauss_idx,element_number,1,piolatensor(1,1),err,error,*999)
2032  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2033  & gauss_idx,element_number,2,piolatensor(1,2),err,error,*999)
2034  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2035  & gauss_idx,element_number,3,piolatensor(1,3),err,error,*999)
2036  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2037  & gauss_idx,element_number,4,piolatensor(2,2),err,error,*999)
2038  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2039  & gauss_idx,element_number,5,piolatensor(2,3),err,error,*999)
2040  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2041  & gauss_idx,element_number,6,piolatensor(3,3),err,error,*999)
2042  !CellML computes the deviatoric stress. Add the volumetric component!
2043  piolatensor(1,1)=piolatensor(1,1)+p*f(1,1)
2044  piolatensor(2,2)=piolatensor(2,2)+p*f(2,2)
2045  piolatensor(3,3)=piolatensor(3,3)+p*f(3,3)
2046  piolatensor(1,2)=piolatensor(1,2)+p*f(1,2)
2047  piolatensor(1,3)=piolatensor(1,3)+p*f(1,3)
2048  piolatensor(2,3)=piolatensor(2,3)+p*f(2,3)
2049  piolatensor(2,1)=piolatensor(1,2)
2050  piolatensor(3,1)=piolatensor(1,3)
2051  piolatensor(3,2)=piolatensor(2,3)
2052  ELSE IF(number_of_dimensions==2) THEN
2053  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2054  & gauss_idx,element_number,1,piolatensor(1,1),err,error,*999)
2055  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2056  & gauss_idx,element_number,2,piolatensor(1,2),err,error,*999)
2057  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2058  & gauss_idx,element_number,3,piolatensor(2,2),err,error,*999)
2059  !CellML computes the deviatoric stress. Add the volumetric component!
2060  piolatensor(1,1)=piolatensor(1,1)+p*f(1,1)
2061  piolatensor(2,2)=piolatensor(2,2)+p*f(2,2)
2062  piolatensor(1,2)=piolatensor(1,2)+p*f(1,2)
2063  piolatensor(2,1)=piolatensor(1,2)
2064  ELSE
2065  CALL field_parametersetgetlocalgausspoint(dependent_field,field_u2_variable_type,field_values_set_type, &
2066  & gauss_idx,element_number,1,piolatensor(1,1),err,error,*999)
2067  piolatensor(1,1)=piolatensor(1,1)+p*f(1,1)
2068  ENDIF
2069 
2070  !Compute the Kirchoff stress tensor by pushing the 2nd Piola Kirchoff stress tensor forward \tau = F.S.F^T
2071  CALL matrixproduct(fe,piolatensor,temp,err,error,*999)
2072  CALL matrixproducttranspose(temp,fe,kirchofftensor,err,error,*999)
2073 
2074  !Calculate the Cauchy stress tensor
2075  cauchytensor=kirchofftensor/je
2076 
2077  IF(diagnostics1) THEN
2078  CALL writestring(diagnostic_output_type,"",err,error,*999)
2079  CALL writestring(diagnostic_output_type,"Stress tensors:",err,error,*999)
2080  CALL writestringvalue(diagnostic_output_type," Hydrostatic pressure = ",p,err,error,*999)
2081  CALL writestring(diagnostic_output_type," Second Piola-Kirchoff stress tensor:",err,error,*999)
2082  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
2083  & 3,3,piolatensor,write_string_matrix_name_and_indices, '(" T','(",I1,",:)',' :",3(X,E13.6))', &
2084  & '(12X,3(X,E13.6))',err,error,*999)
2085  CALL writestring(diagnostic_output_type," Cauchy stress tensor:",err,error,*999)
2086  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
2087  & 3,3,cauchytensor,write_string_matrix_name_and_indices,'(" sigma','(",I1,",:)',' :",3(X,E13.6))', &
2088  & '(12X,3(X,E13.6))',err,error,*999)
2089  ENDIF
2090 
2091  !Calculate dPhi/dZ at the gauss point, Phi is the basis function
2092  !CALL FINITE_ELASTICITY_GAUSS_DFDZ(DEPENDENT_INTERPOLATED_POINT,ELEMENT_NUMBER,gauss_idx,NUMBER_OF_DIMENSIONS, &
2093  ! & NUMBER_OF_XI,DFDZ,ERR,ERROR,*999)
2094 
2095  !For membrane theory in 3D space, the final equation is multiplied by thickness. Default to unit thickness if equation set subtype is not membrane
2096  !!TODO Maybe have the thickness as a component in the equations set field. Yes, as we don't need a materials field for CellML constituative laws.
2097  thickness = 1.0_dp
2098  IF(equations_set_subtype == equations_set_membrane_subtype) THEN
2099  IF(number_of_dimensions == 3) THEN
2100  IF(ASSOCIATED(materials_field)) THEN
2101  CALL field_interpolategauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2102  & materials_interpolated_point,err,error,*999)
2103  thickness = materials_interpolated_point%VALUES(materials_interpolated_point%INTERPOLATION_PARAMETERS% &
2104  & field_variable%NUMBER_OF_COMPONENTS,1)
2105  ENDIF
2106  ENDIF
2107  ENDIF
2108 
2109  !!Now add up the residual terms
2110  !element_dof_idx=0
2111  !DO component_idx=1,NUMBER_OF_DIMENSIONS
2112  ! DEPENDENT_COMPONENT_INTERPOLATION_TYPE=DEPENDENT_FIELD%VARIABLES(var1)%COMPONENTS(component_idx)%INTERPOLATION_TYPE
2113  ! IF(DEPENDENT_COMPONENT_INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN !node based
2114  ! DEPENDENT_BASIS=>DEPENDENT_FIELD%VARIABLES(var1)%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY% &
2115  ! & ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS
2116  ! NUMBER_OF_FIELD_COMPONENT_INTERPOLATION_PARAMETERS=DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS
2117  ! DO parameter_idx=1,NUMBER_OF_FIELD_COMPONENT_INTERPOLATION_PARAMETERS
2118  ! element_dof_idx=element_dof_idx+1
2119  ! DO component_idx2=1,NUMBER_OF_DIMENSIONS
2120  ! NONLINEAR_MATRICES%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2121  ! & NONLINEAR_MATRICES%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2122  ! & GAUSS_WEIGHT*Jzxi*THICKNESS*cauchyTensor(component_idx,component_idx2)* &
2123  ! & DFDZ(parameter_idx,component_idx2,component_idx)
2124  ! ENDDO ! component_idx2 (inner component index)
2125  ! ENDDO ! parameter_idx (residual vector loop)
2126  ! ELSEIF(DEPENDENT_COMPONENT_INTERPOLATION_TYPE==FIELD_ELEMENT_BASED_INTERPOLATION) THEN
2127  ! !Will probably never be used
2128  ! CALL FlagError("Finite elasticity with element based interpolation is not implemented.",ERR,ERROR,*999)
2129  ! ENDIF
2130  !ENDDO ! component_idx
2131 
2132  !Loop over geometric dependent basis functions.
2133  DO nh=1,number_of_dimensions
2134  mesh_component_number=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
2135  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
2136  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2137  component_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2138  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2139  !Loop over derivative directions.
2140  DO mh=1,number_of_dimensions
2141  sum1=0.0_dp
2142  DO mi=1,number_of_xi
2143  sum1=sum1+dependent_interpolated_point_metrics%DXI_DX(mi,mh)* &
2144  & component_quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(mi),gauss_idx)
2145  ENDDO !mi
2146  dphidz(mh,ns,nh)=sum1
2147  ENDDO !mh
2148  ENDDO !ns
2149  ENDDO !nh
2150  jgw=jzxi*dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
2151  !Now add up the residual terms
2152  mhs=0
2153  DO mh=1,number_of_dimensions
2154  mesh_component_number=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2155  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
2156  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2157  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2158  mhs=mhs+1
2159  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+ &
2160  & jgw*dot_product(dphidz(:,ms,mh),cauchytensor(:,mh))
2161  ENDDO !ms
2162  ENDDO !mh
2163 
2164  !Hydrostatic pressure component (skip for membrane problems)
2165  IF (equations_set_subtype /= equations_set_membrane_subtype) THEN
2166  hydrostatic_pressure_component=dependent_field%VARIABLES(var1)%NUMBER_OF_COMPONENTS
2167  dependent_component_interpolation_type=dependent_field%VARIABLES(var1)%COMPONENTS(hydrostatic_pressure_component)% &
2168  & interpolation_type
2169  IF(equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
2170  tempterm1=gauss_weight*(jzxi-(jg-darcy_vol_increase)*jxxi)
2171  ELSE
2172  tempterm1=gauss_weight*(jzxi-jg*jxxi)
2173  ENDIF
2174  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
2175  component_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(hydrostatic_pressure_component)%DOMAIN% &
2176  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2177  component_quadrature_scheme=>component_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2178  number_of_field_component_interpolation_parameters=component_basis%NUMBER_OF_ELEMENT_PARAMETERS
2179  DO parameter_idx=1,number_of_field_component_interpolation_parameters
2180  element_dof_idx=element_dof_idx+1
2181  IF(equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
2182  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2183  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2184  & gauss_weight*jzxi*component_quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,1,gauss_idx)* &
2185  & (je-1.0_dp-darcy_vol_increase)
2186  ELSE
2187  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2188  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2189  & gauss_weight*jzxi*component_quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,1,gauss_idx)* &
2190  & (je-1.0_dp)
2191  ENDIF
2192  ENDDO
2193  ELSEIF(dependent_component_interpolation_type==field_element_based_interpolation) THEN !element based
2194  mhs=mhs+1
2195  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)= &
2196  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+tempterm1
2197  ENDIF
2198  ENDIF
2199  ENDDO !gauss_idx
2200 
2201  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
2202  IF(decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
2203  & total_number_of_surface_pressure_conditions>0) THEN !
2204  CALL finiteelasticity_surfacepressureresidualevaluate(equations_set,element_number,var1,var2,err,error,*999)
2205  ENDIF
2206 
2207  ! ---------------------------------------------------------------
2208  CASE(equations_set_incompressible_elast_multi_comp_darcy_subtype)
2209  !keep the multi-compartment case separate for the time being until the formulation has been finalised, then perhaps
2210  !integrate within the single compartment case
2211  !Loop over gauss points and add residuals
2212  equations_set_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
2213  CALL field_parameter_set_data_get(equations_set_field,field_u_variable_type, &
2214  & field_values_set_type,equations_set_field_data,err,error,*999)
2215 
2216  ncompartments = equations_set_field_data(2)
2217 
2218  DO gauss_idx=1,dependent_number_of_gauss_points
2219  gauss_weight=dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
2220  !Interpolate dependent, geometric, fibre and materials fields
2221  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2222  & dependent_interpolated_point,err,error,*999)
2223  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI,dependent_interpolated_point_metrics, &
2224  & err,error,*999)
2225  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2226  & geometric_interpolated_point,err,error,*999)
2227  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,geometric_interpolated_point_metrics, &
2228  & err,error,*999)
2229  IF(ASSOCIATED(fibre_field)) THEN
2230  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2231  & fibre_interpolated_point,err,error,*999)
2232  END IF
2233  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2234  & materials_interpolated_point,err,error,*999)
2235 
2236  IF(diagnostics1) THEN
2237  CALL write_string_value(diagnostic_output_type," ELEMENT_NUMBER = ",element_number,err,error,*999)
2238  CALL write_string_value(diagnostic_output_type," gauss_idx = ",gauss_idx,err,error,*999)
2239  ENDIF
2240  IF(diagnostics1) THEN
2241  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
2242  & 3,3,piolatensor,write_string_matrix_name_and_indices,'(" Piola Tensor','(",I1,",:)',' :",3(X,E13.6))', &
2243  & '(17X,3(X,E13.6))',err,error,*999)
2244 
2245  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
2246  & 3,3,cauchytensor,write_string_matrix_name_and_indices,'(" Cauchy Tensor','(",I1,",:)',' :",3(X,E13.6))', &
2247  & '(17X,3(X,E13.6))',err,error,*999)
2248  ENDIF
2249 
2250  !Parameters settings for coupled elasticity Darcy INRIA model:
2251  CALL get_darcy_finite_elasticity_parameters(darcy_rho_0_f,mfact,bfact,p0fact,err,error,*999)
2252 
2253  darcy_mass_increase = 0.0_dp
2254  DO imatrix=1,ncompartments
2255  darcy_field_var_type=field_v_variable_type+field_number_of_variable_subtypes*(imatrix-1)
2256  darcy_dependent_interpolation_parameters=>&
2257  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(darcy_field_var_type)%PTR
2258 
2259  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
2260  & darcy_dependent_interpolation_parameters,err,error,*999)
2261 
2262  darcy_dependent_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(darcy_field_var_type)%PTR
2263  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2264  & darcy_dependent_interpolated_point,err,error,*999)
2265 
2266  darcy_mass_increase = darcy_mass_increase + darcy_dependent_interpolated_point%VALUES(4,no_part_deriv)
2267  ENDDO
2268 
2269  darcy_vol_increase = darcy_mass_increase / darcy_rho_0_f
2270 
2271  !Calculate F=dZ/dNU, the deformation gradient tensor at the gauss point
2272  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
2273  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
2274 
2275  jxxi=geometric_interpolated_point_metrics%JACOBIAN
2276 
2277  !Calculate Sigma=1/Jznu.FTF', the Cauchy stress tensor at the gauss point
2278  CALL finite_elasticity_gauss_cauchy_tensor(equations_set,dependent_interpolated_point, &
2279  & materials_interpolated_point,darcy_dependent_interpolated_point, &
2280  & independent_interpolated_point,cauchytensor,jznu,dzdnu,element_number,gauss_idx,err,error,*999)
2281 
2282  !Calculate dPhi/dZ at the gauss point, Phi is the basis function
2283  CALL finite_elasticity_gauss_dfdz(dependent_interpolated_point,element_number,gauss_idx,number_of_dimensions, &
2284  & number_of_xi,dfdz,err,error,*999)
2285 
2286  !For membrane theory in 3D space, the final equation is multiplied by thickness. Default to unit thickness if equation set subtype is not membrane
2287  thickness = 1.0_dp
2288  IF(equations_set_subtype == equations_set_membrane_subtype) THEN
2289  IF(number_of_dimensions == 3) THEN
2290  thickness = materials_interpolated_point%VALUES(materials_interpolated_point%INTERPOLATION_PARAMETERS% &
2291  & field_variable%NUMBER_OF_COMPONENTS,1)
2292  ENDIF
2293  ENDIF
2294 
2295  !Now add up the residual terms
2296  element_dof_idx=0
2297  DO component_idx=1,number_of_dimensions
2298  dependent_component_interpolation_type=dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%INTERPOLATION_TYPE
2299  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
2300  dependent_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY% &
2301  & elements%ELEMENTS(element_number)%BASIS
2302  number_of_field_component_interpolation_parameters=dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2303  DO parameter_idx=1,number_of_field_component_interpolation_parameters
2304  element_dof_idx=element_dof_idx+1
2305  DO component_idx2=1,number_of_dimensions
2306  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2307  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2308  & gauss_weight*jxxi*jznu*thickness*cauchytensor(component_idx,component_idx2)* &
2309  & dfdz(parameter_idx,component_idx2,component_idx)
2310  ENDDO ! component_idx2 (inner component index)
2311  ENDDO ! parameter_idx (residual vector loop)
2312  ELSEIF(dependent_component_interpolation_type==field_element_based_interpolation) THEN
2313  !Will probably never be used
2314  CALL flagerror("Finite elasticity with element based interpolation is not implemented.",err,error,*999)
2315  ENDIF
2316  ENDDO ! component_idx
2317 
2318  !Hydrostatic pressure component (skip for membrane problems)
2319  IF (equations_set_subtype /= equations_set_membrane_subtype) THEN
2320  hydrostatic_pressure_component=dependent_field%VARIABLES(var1)%NUMBER_OF_COMPONENTS
2321  dependent_component_interpolation_type=dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%INTERPOLATION_TYPE
2322  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
2323  component_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(hydrostatic_pressure_component)%DOMAIN% &
2324  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2325  component_quadrature_scheme=>component_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2326  number_of_field_component_interpolation_parameters=component_basis%NUMBER_OF_ELEMENT_PARAMETERS
2327  DO parameter_idx=1,number_of_field_component_interpolation_parameters
2328  element_dof_idx=element_dof_idx+1
2329  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2330  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2331  & gauss_weight*jxxi*component_quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,1,gauss_idx)* &
2332  & (jznu-1.0_dp-darcy_vol_increase)
2333  ENDDO
2334  ELSEIF(dependent_component_interpolation_type==field_element_based_interpolation) THEN !element based
2335  element_dof_idx=element_dof_idx+1
2336  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2337  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+gauss_weight*jxxi* &
2338  & (jznu-1.0_dp-darcy_vol_increase)
2339  ENDIF
2340  ENDIF
2341  ENDDO !gauss_idx
2342 
2343  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
2344  IF(decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
2345  & total_number_of_surface_pressure_conditions>0) THEN !
2346  CALL finiteelasticity_surfacepressureresidualevaluate(equations_set,element_number,var1,var2,err,error,*999)
2347  ENDIF
2348 
2349  CASE (equations_set_compressible_finite_elasticity_subtype, &
2350  & equations_set_compressible_activecontraction_subtype, &
2351  & equations_set_elasticity_darcy_inria_model_subtype, &
2352  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
2353  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
2354  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
2355  & equations_set_nearly_incompressible_mooney_rivlin_subtype)
2356  !compressible problem (no pressure component)
2357 
2358  !Loop over gauss points and add up residuals
2359  DO gauss_idx=1,dependent_number_of_gauss_points
2360  gauss_weight=dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
2361 
2362  !Interpolate fields at the gauss points
2363  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2364  & dependent_interpolated_point,err,error,*999)
2365  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI,dependent_interpolated_point_metrics, &
2366  & err,error,*999)
2367  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2368  & geometric_interpolated_point,err,error,*999)
2369  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,geometric_interpolated_point_metrics, &
2370  & err,error,*999)
2371  IF(ASSOCIATED(fibre_field)) THEN
2372  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2373  & fibre_interpolated_point,err,error,*999)
2374  END IF
2375  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2376  & materials_interpolated_point,err,error,*999)
2377  IF(darcy_dependent) THEN
2378  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2379  & darcy_dependent_interpolated_point,err,error,*999) ! 'FIRST_PART_DERIV' required ???
2380  ENDIF
2381 
2382  !Calculate F=dZ/dNU at the gauss point
2383  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
2384  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
2385 
2386  jxxi=geometric_interpolated_point_metrics%JACOBIAN
2387 
2388  !Calculate Cauchy stress tensor at the gauss point
2389  CALL finite_elasticity_gauss_cauchy_tensor(equations_set,dependent_interpolated_point, &
2390  & materials_interpolated_point,darcy_dependent_interpolated_point, &
2391  & independent_interpolated_point,cauchytensor,jznu,dzdnu,element_number,gauss_idx,err,error,*999)
2392 
2393  !Calculate dF/DZ at the gauss point
2394  CALL finite_elasticity_gauss_dfdz(dependent_interpolated_point,element_number,gauss_idx,number_of_dimensions, &
2395  & number_of_xi,dfdz,err,error,*999)
2396 
2397  !Add up the residual terms
2398  element_dof_idx=0
2399  DO component_idx=1,dependent_number_of_components
2400  dependent_component_interpolation_type=dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%INTERPOLATION_TYPE
2401  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
2402  dependent_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY% &
2403  & elements%ELEMENTS(element_number)%BASIS
2404  number_of_field_component_interpolation_parameters=dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2405  DO parameter_idx=1,number_of_field_component_interpolation_parameters
2406  element_dof_idx=element_dof_idx+1
2407  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
2408  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ &
2409  & gauss_weight*jxxi*jznu*(cauchytensor(component_idx,1)*dfdz(parameter_idx,1,component_idx)+ &
2410  & cauchytensor(component_idx,2)*dfdz(parameter_idx,2,component_idx)+ &
2411  & cauchytensor(component_idx,3)*dfdz(parameter_idx,3,component_idx))
2412  ENDDO
2413  ELSEIF(dependent_component_interpolation_type==field_element_based_interpolation) THEN
2414  !Will probably never be used
2415  CALL flagerror("Finite elasticity with element based interpolation is not implemented.",err,error,*999)
2416  ENDIF
2417  ENDDO !component_idx
2418  ENDDO !gauss_idx
2419 
2420  !Call surface pressure term here: should only be executed if THIS element has surface pressure on it (direct or incremented)
2421  IF(decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BOUNDARY_ELEMENT.AND. &
2422  & total_number_of_surface_pressure_conditions>0) THEN !
2423  CALL finiteelasticity_surfacepressureresidualevaluate(equations_set,element_number,var1,var2,err,error,*999)
2424  ENDIF
2425  END SELECT
2426  IF(ASSOCIATED(rhs_vector)) THEN
2427  IF(ASSOCIATED(source_field)) THEN
2428  IF(ASSOCIATED(materials_field%VARIABLE_TYPE_MAP(field_v_variable_type)%PTR)) THEN
2429  density_interpolation_parameters=>equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS(field_v_variable_type)%PTR
2430  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
2431  & density_interpolation_parameters,err,error,*999)
2432  density_interpolated_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR
2433  IF(darcy_density) THEN
2434  darcy_materials_interpolation_parameters=>equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS( &
2435  & field_u1_variable_type)%PTR
2436  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
2437  & darcy_materials_interpolation_parameters,err,error,*999)
2438  darcy_materials_interpolated_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u1_variable_type)%PTR
2439  ENDIF
2440  IF(rhs_vector%UPDATE_VECTOR) THEN
2441  source_interpolation_parameters=>equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS(field_u_variable_type)%PTR
2442  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
2443  & source_interpolation_parameters,err,error,*999)
2444  source_interpolated_point=>equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR
2445 
2446  DO gauss_idx=1,dependent_number_of_gauss_points
2447  gauss_weight=dependent_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)
2448  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2449  & source_interpolated_point,err,error,*999)
2450  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx,equations%INTERPOLATION% &
2451  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
2452  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2453  & density_interpolated_point,err,error,*999)
2454  IF(darcy_density) THEN
2455  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
2456  & darcy_materials_interpolated_point,err,error,*999)
2457  !Account for separate fluid and solid proportions and densities
2458  !Total lagrangian density = m_s + m_f = rho^0_s * (1 - phi^0) + rho_f * phi
2459  !By assuming solid incompressibility, phi = (J - 1 + phi^0)
2460  !\todo: Think about how this fits in with the constitutive relation, and what happens when the solid
2461  !isn't incompressible. Can we assume the solid is incompressible if we aren't enforcing that in the
2462  !constitutive relation?
2463  density=density_interpolated_point%VALUES(1,1)*(1.0_dp-darcy_materials_interpolated_point%VALUES(8,1)) + &
2464  & darcy_materials_interpolated_point%VALUES(7,1)*(jznu-1.0_dp+darcy_materials_interpolated_point%VALUES(8,1))
2465  ELSE
2466  density=density_interpolated_point%VALUES(1,1)
2467  ENDIF
2468  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2469  & dependent_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2470  element_dof_idx=0
2471  DO component_idx=1,number_of_dimensions
2472  dependent_basis=>dependent_field%VARIABLES(var1)%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY% &
2473  & elements%ELEMENTS(element_number)%BASIS
2474  DO parameter_idx=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2475  element_dof_idx=element_dof_idx+1
2476  rhs_vector%ELEMENT_VECTOR%VECTOR(element_dof_idx)=rhs_vector%ELEMENT_VECTOR%VECTOR(element_dof_idx) + &
2477  & density*source_interpolated_point%VALUES(component_idx,1) * &
2478  & dependent_quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,no_part_deriv,gauss_idx)*gauss_weight * &
2479  & equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN
2480  ENDDO
2481  ENDDO
2482  ENDDO !gauss_idx
2483  ENDIF
2484  ENDIF
2485  ENDIF
2486  ELSE
2487  CALL flagerror("RHS vector is not associated.",err,error,*999)
2488  ENDIF
2489 
2490  !Scale factor adjustment
2491  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
2492  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
2493  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2494  mhs=0
2495  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2496  !Loop over element rows
2497  dependent_component_interpolation_type=dependent_field%VARIABLES(field_var_type)%COMPONENTS(mh)%INTERPOLATION_TYPE
2498  IF(dependent_component_interpolation_type==field_node_based_interpolation) THEN !node based
2499  dependent_basis=>dependent_field%VARIABLES(field_var_type)%COMPONENTS(mh)%DOMAIN%TOPOLOGY% &
2500  & elements%ELEMENTS(element_number)%BASIS
2501  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2502  mhs=mhs+1
2503  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)* &
2504  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2505  IF(ASSOCIATED(rhs_vector)) THEN
2506  IF(ASSOCIATED(source_field)) THEN
2507  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
2508  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2509  ENDIF
2510  ENDIF
2511  ENDDO !ms
2512  ENDIF
2513  ENDDO !mh
2514  ENDIF
2515 
2516  ELSE
2517  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2518  ENDIF
2519  ELSE
2520  CALL flagerror("Equations set is not associated.",err,error,*999)
2521  ENDIF
2522 
2523  IF(diagnostics5) THEN
2524  !Output element residual vector for first element
2525  IF(element_number == 1) THEN
2526  ndofs = 0
2527  field_variable=>dependent_field%VARIABLES(var1) ! 'U' variable
2528  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2529  SELECT CASE(field_variable%COMPONENTS(mh)%INTERPOLATION_TYPE)
2530  CASE(field_node_based_interpolation)
2531  mesh_component_1 = field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2532  dependent_basis_1 => dependent_field%DECOMPOSITION%DOMAIN(mesh_component_1)%ptr% &
2533  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2534  ndofs = ndofs + dependent_basis_1%NUMBER_OF_ELEMENT_PARAMETERS
2535  CALL write_string_value(diagnostic_output_type,"EP: ",dependent_basis_1%NUMBER_OF_ELEMENT_PARAMETERS,err,error,*999)
2536  CASE(field_element_based_interpolation)
2537  ndofs = ndofs + 1
2538  CALL write_string_value(diagnostic_output_type,"EP: ",1,err,error,*999)
2539  CASE DEFAULT
2540  CALL flagerror("Interpolation type " &
2541  & //trim(number_to_vstring(field_variable%COMPONENTS(mh)%INTERPOLATION_TYPE,"*",err,error))// &
2542  & " is not valid for a finite elasticity equation.",err,error,*999)
2543  END SELECT
2544  END DO
2545  CALL write_string_value(diagnostic_output_type,"NDOFS: ",ndofs,err,error,*999)
2546  CALL write_string(diagnostic_output_type,"Element Vector for element number * (Fin.Elast.):",err,error,*999)
2547  CALL write_string_value(diagnostic_output_type,"Element Vector for element number (Fin.Elast.): ", &
2548  & element_number,err,error,*999)
2549  CALL writestringvector(diagnostic_output_type,1,1,ndofs,ndofs,ndofs,&
2550  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(:), &
2551  & '(4(X,E13.6))','4(4(X,E13.6))',err,error,*999)
2552  ENDIF
2553  ENDIF
2554 
2555  exits("FiniteElasticity_FiniteElementResidualEvaluate")
2556  RETURN
2557 999 errors("FiniteElasticity_FiniteElementResidualEvaluate",err,error)
2558  exits("FiniteElasticity_FiniteElementResidualEvaluate")
2559  RETURN 1
2560 
2561  END SUBROUTINE finiteelasticity_finiteelementresidualevaluate
2562 
2563  !
2564  !================================================================================================================================
2565  !
2566 
2568  SUBROUTINE finiteelasticity_finiteelementpreresidualevaluate(EQUATIONS_SET,ERR,ERROR,*)
2569 
2570  !Argument variables
2571  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2572  INTEGER(INTG), INTENT(OUT) :: ERR
2573  TYPE(varying_string), INTENT(OUT) :: ERROR
2574  !Local Variables
2575  TYPE(varying_string) :: LOCAL_ERROR
2576  TYPE(field_type), POINTER :: DEPENDENT_FIELD
2577 
2578  enters("FiniteElasticity_FiniteElementPreResidualEvaluate",err,error,*999)
2579 
2580  IF(ASSOCIATED(equations_set)) THEN
2581  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2582  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2583  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2584  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
2585  & err,error,*999)
2586  END IF
2587  SELECT CASE(equations_set%SPECIFICATION(3))
2588  CASE(equations_set_constitutive_law_in_cellml_evaluate_subtype, &
2589  & equations_set_constitutive_and_growth_law_in_cellml_subtype)
2590  dependent_field=>equations_set%EQUATIONS%INTERPOLATION%DEPENDENT_FIELD
2591  CALL finiteelasticity_straincalculate(equations_set,dependent_field, &
2592  & field_u1_variable_type,err,error,*999)
2593  CASE(equations_set_membrane_subtype,equations_set_mooney_rivlin_subtype, &
2594  & equations_set_mooney_rivlin_activecontraction_subtype, &
2595  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
2596  & equations_set_isotropic_exponential_subtype, &
2597  & equations_set_transverse_isotropic_exponential_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
2598  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
2599  & equations_set_trans_isotropic_active_transition_subtype,equations_set_transverse_isotropic_active_subtype, &
2600  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype,&
2601  & equations_set_compressible_activecontraction_subtype, &
2602  & equations_set_activecontraction_subtype, equations_set_no_subtype, &
2603  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
2604  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
2605  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
2606  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
2607  & equations_set_incompressible_elast_multi_comp_darcy_subtype,equations_set_transverse_isotropic_guccione_subtype, &
2608  & equations_set_guccione_activecontraction_subtype, &
2609  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
2610  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
2611  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
2612  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
2613  & equations_set_standard_monodomain_elasticity_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
2614  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_active_strain_subtype, &
2615  & equations_set_multiscale_active_strain_subtype,equations_set_1d3d_monodomain_active_strain_subtype, &
2616  & equations_set_monodomain_elasticity_velocity_subtype, &
2617  & equations_set_holzapfel_ogden_activecontraction_subtype)
2618  !Do nothing ???
2619  CASE DEFAULT
2620  local_error="The third equations set specification of "// &
2621  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2622  & " is not valid for a finite elasticity type of an elasticity equation set."
2623  CALL flagerror(local_error,err,error,*999)
2624  END SELECT
2625  ELSE
2626  CALL flagerror("Equations set is not associated.",err,error,*999)
2627  ENDIF
2628 
2629  exits("FiniteElasticity_FiniteElementPreResidualEvaluate")
2630  RETURN
2631 999 errors("FiniteElasticity_FiniteElementPreResidualEvaluate",err,error)
2632  exits("FiniteElasticity_FiniteElementPreResidualEvaluate")
2633  RETURN 1
2634 
2635  END SUBROUTINE finiteelasticity_finiteelementpreresidualevaluate
2636 
2637  !
2638  !================================================================================================================================
2639  !
2640 
2642  SUBROUTINE finiteelasticity_finiteelementpostresidualevaluate(EQUATIONS_SET,ERR,ERROR,*)
2643 
2644  !Argument variables
2645  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2646  INTEGER(INTG), INTENT(OUT) :: ERR
2647  TYPE(varying_string), INTENT(OUT) :: ERROR
2648  !Local Variables
2649  TYPE(varying_string) :: LOCAL_ERROR
2650 
2651  enters("FiniteElasticity_FiniteElementPostResidualEvaluate",err,error,*999)
2652 
2653  IF(ASSOCIATED(equations_set)) THEN
2654  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2655  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2656  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2657  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
2658  & err,error,*999)
2659  END IF
2660  SELECT CASE(equations_set%SPECIFICATION(3))
2661  CASE(equations_set_membrane_subtype,equations_set_mooney_rivlin_subtype, &
2662  & equations_set_mooney_rivlin_activecontraction_subtype, &
2663  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
2664  & equations_set_isotropic_exponential_subtype, &
2665  & equations_set_transverse_isotropic_exponential_subtype,equations_set_standard_monodomain_elasticity_subtype, &
2666  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype,&
2667  & equations_set_compressible_activecontraction_subtype,equations_set_transverse_isotropic_active_subtype, &
2668  & equations_set_trans_isotropic_active_transition_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
2669  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
2670  & equations_set_activecontraction_subtype,equations_set_no_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
2671  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_active_strain_subtype, &
2672  & equations_set_multiscale_active_strain_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
2673  & equations_set_1d3d_monodomain_active_strain_subtype, &
2674  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
2675  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
2676  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
2677  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
2678  & equations_set_incompressible_elast_multi_comp_darcy_subtype,equations_set_transverse_isotropic_guccione_subtype, &
2679  & equations_set_guccione_activecontraction_subtype, &
2680  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
2681  & equations_set_transverse_isotropic_humphrey_yin_subtype,&
2682  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
2683  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
2684  & equations_set_constitutive_law_in_cellml_evaluate_subtype, &
2685  & equations_set_holzapfel_ogden_activecontraction_subtype, &
2686  & equations_set_constitutive_and_growth_law_in_cellml_subtype)
2687  !Do nothing ???
2688  CASE DEFAULT
2689  local_error="The third equations set specification of "// &
2690  & trim(numbertovstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2691  & " is not valid for a finite elasticity type of an elasticity equation set."
2692  CALL flagerror(local_error,err,error,*999)
2693  END SELECT
2694  ELSE
2695  CALL flagerror("Equations set is not associated.",err,error,*999)
2696  ENDIF
2697 
2698  exits("FiniteElasticity_FiniteElementPostResidualEvaluate")
2699  RETURN
2700 999 errors("FiniteElasticity_FiniteElementPostResidualEvaluate",err,error)
2701  exits("FiniteElasticity_FiniteElementPostResidualEvaluate")
2702  RETURN 1
2703 
2704  END SUBROUTINE finiteelasticity_finiteelementpostresidualevaluate
2705 
2706  !
2707  !================================================================================================================================
2708  !
2709 
2711  SUBROUTINE finiteelasticityequationsset_derivedvariablecalculate(equationsSet,derivedType,err,error,*)
2712 
2713  !Argument variables
2714  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
2715  INTEGER(INTG), INTENT(IN) :: derivedType
2716  INTEGER(INTG), INTENT(OUT) :: err
2717  TYPE(varying_string), INTENT(OUT) :: error
2718 
2719  !Local variables
2720  TYPE(field_variable_type), POINTER :: derivedVariable
2721 
2722  enters("FiniteElasticityEquationsSet_DerivedVariableCalculate",err,error,*999)
2723 
2724  NULLIFY(derivedvariable)
2725 
2726  IF(ASSOCIATED(equationsset)) THEN
2727  IF(.NOT.equationsset%EQUATIONS_SET_FINISHED) THEN
2728  CALL flagerror("Equations set has not been finished.",err,error,*999)
2729  ELSE
2730  IF(ASSOCIATED(equationsset%equations)) THEN
2731  CALL equations_derivedvariableget(equationsset%equations,derivedtype,derivedvariable,err,error,*999)
2732  SELECT CASE(derivedtype)
2733  CASE(equations_set_derived_strain)
2734  CALL finiteelasticity_straincalculate(equationsset, &
2735  & derivedvariable%field,derivedvariable%variable_type,err,error,*999)
2736  CASE(equations_set_derived_stress)
2737  CALL flagerror("Not implemented.",err,error,*999)
2738  CASE DEFAULT
2739  CALL flagerror("Equations set derived field type of "//trim(number_to_vstring(derivedtype,"*",err,error))// &
2740  & " is not valid for a finite elasticity equations set type.",err,error,*999)
2741  END SELECT
2742  ELSE
2743  CALL flagerror("Equations set equations are not associated.",err,error,*999)
2744  END IF
2745  END IF
2746  ELSE
2747  CALL flagerror("Equations set is not associated.",err,error,*999)
2748  END IF
2749 
2750  exits("FiniteElasticityEquationsSet_DerivedVariableCalculate")
2751  RETURN
2752 999 errors("FiniteElasticityEquationsSet_DerivedVariableCalculate",err,error)
2753  exits("FiniteElasticityEquationsSet_DerivedVariableCalculate")
2754  RETURN 1
2755  END SUBROUTINE finiteelasticityequationsset_derivedvariablecalculate
2756 
2757  !
2758  !================================================================================================================================
2759  !
2760 
2762  SUBROUTINE finiteelasticity_straincalculate(equationsSet,strainField,strainFieldVariableType,err,error,*)
2763 
2764  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
2765  TYPE(field_type), POINTER, INTENT(INOUT) :: strainField
2766  INTEGER(INTG), INTENT(IN) :: strainFieldVariableType
2767  INTEGER(INTG), INTENT(OUT) :: err
2768  TYPE(varying_string), INTENT(OUT) :: error
2769  !Local Variables
2770  TYPE(basis_type), POINTER :: dependentBasis
2771  TYPE(equations_type), POINTER :: equations
2772  TYPE(field_type), POINTER :: dependentField,geometricField,fibreField
2773  TYPE(quadrature_scheme_type), POINTER :: dependentQuadratureScheme
2774  TYPE(field_interpolation_parameters_type), POINTER :: geometricInterpolationParameters,dependentInterpolationParameters, &
2775  & fibreInterpolationParameters
2776  TYPE(field_interpolated_point_type), POINTER :: geometricInterpolatedPoint,dependentInterpolatedPoint,fibreInterpolatedPoint
2777  TYPE(field_interpolated_point_metrics_type), POINTER ::geometricInterpolatedPointMetrics,dependentInterpolatedPointMetrics
2778  TYPE(decomposition_type), POINTER :: decomposition
2779  TYPE(domain_mapping_type), POINTER :: elementsMapping
2780  TYPE(varying_string) :: localError
2781  INTEGER(INTG) :: componentIdx,dependentNumberOfComponents,elementIdx,elementNumber,fieldVariableType,gaussIdx, &
2782  & meshComponentNumber,numberOfComponents,numberOfDimensions,numberOfGauss,numberOfTimes,numberOfXi,partIdx, &
2783  & startIdx,finishIdx
2784  INTEGER(INTG) :: var1 ! Variable number corresponding to 'U' in single physics case
2785  INTEGER(INTG) :: var2 ! Variable number corresponding to 'DELUDLEN' in single physics case
2786  REAL(DP) :: dZdNu(3,3),Fg(3,3),Fe(3,3),J,Jg,Je,C(3,3),f(3,3),E(3,3)
2787  REAL(SP) :: elementUserElapsed,elementSystemElapsed,systemElapsed,systemTime1(1),systemTime2(1),systemTime3(1),systemTime4(1), &
2788  & userElapsed,userTime1(1),userTime2(1),userTime3(1),userTime4(1)
2789 
2790  enters("FiniteElasticity_StrainCalculate",err,error,*999)
2791 
2792  IF(ASSOCIATED(equationsset)) THEN
2793  equations=>equationsset%equations
2794  IF(ASSOCIATED(equations)) THEN
2795  numberofdimensions=equationsset%region%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
2796 
2797  !Check the provided strain field has appropriate components and interpolation
2798  IF(ASSOCIATED(strainfield)) THEN
2799  CALL field_variabletypecheck(strainfield,strainfieldvariabletype,err,error,*999)
2800  SELECT CASE(numberofdimensions)
2801  CASE(3)
2802  numberofcomponents=6
2803  CASE(2)
2804  numberofcomponents=3
2805  CASE(1)
2806  numberofcomponents=1
2807  CASE DEFAULT
2808  CALL flagerror("The number of dimensions of "//trim(number_to_vstring(numberofdimensions,"*",err,error))// &
2809  & " is invalid.",err,error,*999)
2810  END SELECT
2811  CALL field_numberofcomponentscheck(strainfield,strainfieldvariabletype,6,err,error,*999)
2812  DO componentidx=1,numberofcomponents
2813  CALL field_componentinterpolationcheck(strainfield,strainfieldvariabletype,componentidx, &
2814  & field_gauss_point_based_interpolation,err,error,*999)
2815  ENDDO !componentIdx
2816  ELSE
2817  CALL flagerror("Strain field is not associated.",err,error,*999)
2818  END IF
2819 
2820  !Which variables are we working with - find the variable pair used for this equations set
2821  !\todo: put in checks for all the objects/mappings below TODO
2822 
2823  var1=equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR%VARIABLE_NUMBER ! number for 'U'
2824  var2=equations%EQUATIONS_MAPPING%RHS_MAPPING%RHS_VARIABLE%VARIABLE_NUMBER ! number for 'DELUDELN'
2825 
2826  geometricfield=>equations%interpolation%GEOMETRIC_FIELD
2827  dependentfield=>equations%interpolation%DEPENDENT_FIELD
2828  fibrefield=>equations%interpolation%FIBRE_FIELD
2829  dependentnumberofcomponents=dependentfield%variables(var1)%NUMBER_OF_COMPONENTS
2830 
2831  decomposition=>dependentfield%decomposition
2832  meshcomponentnumber=decomposition%MESH_COMPONENT_NUMBER
2833 
2834  !Grab interpolation points
2835  fieldvariabletype=equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR%VARIABLE_TYPE
2836  geometricinterpolationparameters=>equations%interpolation%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%ptr
2837  geometricinterpolatedpoint=>equations%interpolation%GEOMETRIC_INTERP_POINT(field_u_variable_type)%ptr
2838  geometricinterpolatedpointmetrics=>equations%interpolation%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%ptr
2839  dependentinterpolationparameters=>equations%interpolation%DEPENDENT_INTERP_PARAMETERS(fieldvariabletype)%ptr
2840  dependentinterpolatedpoint=>equations%interpolation%DEPENDENT_INTERP_POINT(fieldvariabletype)%ptr
2841  dependentinterpolatedpointmetrics=>equations%interpolation%DEPENDENT_INTERP_POINT_METRICS(fieldvariabletype)%ptr
2842  IF(ASSOCIATED(fibrefield)) THEN
2843  fibreinterpolationparameters=>equations%interpolation%FIBRE_INTERP_PARAMETERS(field_u_variable_type)%ptr
2844  fibreinterpolatedpoint=>equations%interpolation%FIBRE_INTERP_POINT(field_u_variable_type)%ptr
2845  ELSE
2846  NULLIFY(fibreinterpolationparameters)
2847  NULLIFY(fibreinterpolatedpoint)
2848  ENDIF
2849 
2850  elementsmapping=>dependentfield%decomposition%domain(meshcomponentnumber)%ptr%mappings%elements
2851 
2852  numberoftimes=0
2853 
2854  !Loop over the two parts: 1 - boundary and ghost elements, 2 - internal
2855  DO partidx=1,2
2856 
2857  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
2858  CALL cpu_timer(user_cpu,usertime1,err,error,*999)
2859  CALL cpu_timer(system_cpu,systemtime1,err,error,*999)
2860  ENDIF
2861 
2862  IF(partidx==1) THEN
2863  startidx=elementsmapping%BOUNDARY_START
2864  finishidx=elementsmapping%GHOST_FINISH
2865  ELSE
2866  startidx=elementsmapping%INTERNAL_START
2867  finishidx=elementsmapping%INTERNAL_FINISH
2868  ENDIF
2869 
2870  !Loop over (1) the boundary and ghost elements, (2) the internal elements
2871  DO elementidx=startidx,finishidx
2872 
2873  numberoftimes=numberoftimes+1
2874  elementnumber=elementsmapping%DOMAIN_LIST(elementidx)
2875 
2876  IF(diagnostics1) THEN
2877  CALL writestringvalue(diagnostic_output_type," Element number = ",elementnumber,err,error,*999)
2878  ENDIF
2879 
2880  dependentbasis=>decomposition%domain(meshcomponentnumber)%ptr%topology%elements%elements(elementnumber)%basis
2881  dependentquadraturescheme=>dependentbasis%quadrature%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2882  numberofgauss=dependentquadraturescheme%NUMBER_OF_GAUSS
2883 
2884  numberofxi=dependentbasis%NUMBER_OF_XI
2885 
2886  CALL field_interpolationparameterselementget(field_values_set_type,elementnumber,geometricinterpolationparameters, &
2887  & err,error,*999)
2888  CALL field_interpolationparameterselementget(field_values_set_type,elementnumber,dependentinterpolationparameters, &
2889  & err,error,*999)
2890  IF(ASSOCIATED(fibrefield)) THEN
2891  CALL field_interpolationparameterselementget(field_values_set_type,elementnumber,fibreinterpolationparameters, &
2892  & err,error,*999)
2893  ENDIF
2894 
2895  !Loop over gauss points
2896  DO gaussidx=1,numberofgauss
2897 
2898  IF(diagnostics1) THEN
2899  CALL writestringvalue(diagnostic_output_type," Gauss point number = ",gaussidx,err,error,*999)
2900  ENDIF
2901 
2902  !Interpolate dependent, geometric, fibre fields
2903  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gaussidx,dependentinterpolatedpoint, &
2904  & err,error,*999)
2905  CALL field_interpolatedpointmetricscalculate(numberofxi,dependentinterpolatedpointmetrics,err,error,*999)
2906  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gaussidx,geometricinterpolatedpoint, &
2907  & err,error,*999)
2908  CALL field_interpolatedpointmetricscalculate(numberofxi,geometricinterpolatedpointmetrics,err,error,*999)
2909  IF(ASSOCIATED(fibrefield)) THEN
2910  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gaussidx,fibreinterpolatedpoint, &
2911  & err,error,*999)
2912  ENDIF
2913 
2914  !Calculate F=dZ/dNU, the deformation gradient tensor at the gauss point
2915  CALL finiteelasticity_gaussdeformationgradienttensor(dependentinterpolatedpointmetrics, &
2916  & geometricinterpolatedpointmetrics,fibreinterpolatedpoint,dzdnu,err,error,*999)
2917 
2918  CALL finiteelasticity_gaussgrowthtensor(equationsset,numberofdimensions,gaussidx,elementnumber,dependentfield, &
2919  & dzdnu,fg,fe,jg,je,err,error,*999)
2920 
2921  CALL finiteelasticity_straintensor(fe,c,f,j,e,err,error,*999)
2922 
2923  !We only want to store the indepent components of the STRAIN FIELD
2924  SELECT CASE(numberofdimensions)
2925  CASE(3)
2926  ! 3 dimensional problem
2927  ! ORDER OF THE COMPONENTS: U_11, U_12, U_13, U_22, U_23, U_33 (upper triangular matrix)
2928  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2929  & gaussidx,elementnumber,1,c(1,1),err,error,*999)
2930  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2931  & gaussidx,elementnumber,2,c(1,2),err,error,*999)
2932  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2933  & gaussidx,elementnumber,3,c(1,3),err,error,*999)
2934  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2935  & gaussidx,elementnumber,4,c(2,2),err,error,*999)
2936  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2937  & gaussidx,elementnumber,5,c(2,3),err,error,*999)
2938  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2939  & gaussidx,elementnumber,6,c(3,3),err,error,*999)
2940  CASE(2)
2941  ! 2 dimensional problem
2942  ! ORDER OF THE COMPONENTS: U_11, U_12, U_22 (upper triangular matrix)
2943  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2944  & gaussidx,elementnumber,1,c(1,1),err,error,*999)
2945  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2946  & gaussidx,elementnumber,2,c(1,2),err,error,*999)
2947  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2948  & gaussidx,elementnumber,3,c(2,2),err,error,*999)
2949  CASE(1)
2950  ! 1 dimensional problem
2951  CALL field_parametersetupdatelocalgausspoint(strainfield,strainfieldvariabletype,field_values_set_type, &
2952  & gaussidx,elementnumber,1,c(1,1),err,error,*999)
2953  CASE DEFAULT
2954  localerror="The number of dimensions of "//trim(numbertovstring(numberofdimensions,"*",err,error))// &
2955  & " is invalid."
2956  CALL flagerror(localerror,err,error,*999)
2957  END SELECT
2958  ENDDO !gaussIdx
2959  ENDDO !elementIdx
2960 
2961  !Output timing information if required
2962  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
2963  CALL cpu_timer(user_cpu,usertime2,err,error,*999)
2964  CALL cpu_timer(system_cpu,systemtime2,err,error,*999)
2965  userelapsed=usertime2(1)-usertime1(1)
2966  systemelapsed=systemtime2(1)-systemtime1(1)
2967  elementuserelapsed=elementuserelapsed+userelapsed
2968  elementsystemelapsed=elementsystemelapsed+systemelapsed
2969  IF(partidx==1) THEN
2970  CALL writestringvalue(general_output_type,"User time for strain field (boundary+ghost elements) calculation = ", &
2971  & userelapsed,err,error,*999)
2972  CALL writestringvalue(general_output_type,"System time for strain field (boundary+ghost elements) calculation = ", &
2973  & systemelapsed,err,error,*999)
2974  ELSE
2975  CALL writestringvalue(general_output_type,"User time for strain field (internal elements) calculation = ", &
2976  & userelapsed,err,error,*999)
2977  CALL writestringvalue(general_output_type,"System time for strain field (internal elements) calculation = ", &
2978  & systemelapsed,err,error,*999)
2979  IF(numberoftimes>0) THEN
2980  CALL writestringvalue(general_output_type,"Average element user time for strain field calculation = ", &
2981  & elementuserelapsed/numberoftimes,err,error,*999)
2982  CALL writestringvalue(general_output_type,"Average element system time for strain field calculation = ", &
2983  & elementsystemelapsed/numberoftimes,err,error,*999)
2984  ENDIF
2985  ENDIF
2986  ENDIF !EQUATIONS%OUTPUT_TYPE>=EQUATIONS_TIMING_OUTPUT
2987 
2988  IF(partidx==1) THEN
2989  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
2990  CALL cpu_timer(user_cpu,usertime3,err,error,*999)
2991  CALL cpu_timer(system_cpu,systemtime3,err,error,*999)
2992  ENDIF
2993  !Start to update the field
2994  CALL field_parametersetupdatestart(strainfield,strainfieldvariabletype,field_values_set_type,err,error,*999)
2995  ELSE
2996  !Finish to update the field
2997  CALL field_parametersetupdatefinish(strainfield,strainfieldvariabletype,field_values_set_type,err,error,*999)
2998  !Output timing information if required
2999  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
3000  CALL cpu_timer(user_cpu,usertime4,err,error,*999)
3001  CALL cpu_timer(system_cpu,systemtime4,err,error,*999)
3002  userelapsed=usertime4(1)-usertime3(1)
3003  systemelapsed=systemtime4(1)-systemtime3(1)
3004  CALL writestringvalue(general_output_type,"User time for parameter transfer completion = ",userelapsed, &
3005  & err,error,*999)
3006  CALL writestringvalue(general_output_type,"System time for parameter transfer completion = ",systemelapsed, &
3007  & err,error,*999)
3008  ENDIF !EQUATIONS%OUTPUT_TYPE>=EQUATIONS_TIMING_OUTPUT
3009  ENDIF
3010 
3011  ENDDO !partIdx
3012 
3013  ELSE
3014  CALL flagerror("Equations set equations is not associated.",err,error,*999)
3015  ENDIF
3016  ELSE
3017  CALL flagerror("Equations set is not associated.",err,error,*999)
3018  ENDIF
3019 
3020  exits("FiniteElasticity_StrainCalculate")
3021  RETURN
3022 999 errorsexits("FiniteElasticity_StrainCalculate",err,error)
3023  RETURN 1
3024 
3025  END SUBROUTINE finiteelasticity_straincalculate
3026 
3027  !
3028  !================================================================================================================================
3029  !
3030 
3032  SUBROUTINE finiteelasticity_tensorinterpolatexi(equationsSet,tensorEvaluateType,userElementNumber,xi,values,err,error,*)
3033  ! Argument variables
3034  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
3035  INTEGER(INTG), INTENT(IN) :: tensorEvaluateType
3036  INTEGER(INTG), INTENT(IN) :: userElementNumber
3037  REAL(DP), INTENT(IN) :: xi(:)
3038  REAL(DP), INTENT(OUT) :: values(3,3)
3039  INTEGER(INTG), INTENT(OUT) :: err
3040  TYPE(varying_string), INTENT(OUT) :: error
3041  ! Local variables
3042  TYPE(equations_type), POINTER :: equations
3043  TYPE(field_type), POINTER :: dependentField
3044  TYPE(field_interpolated_point_type), POINTER :: geometricInterpolatedPoint, &
3045  & fibreInterpolatedPoint,dependentInterpolatedPoint,materialsInterpolatedPoint, &
3046  & independentInterpolatedPoint,darcyInterpolatedPoint
3047  TYPE(field_interpolated_point_metrics_type), POINTER :: geometricInterpolatedPointMetrics, &
3048  & dependentInterpolatedPointMetrics
3049  TYPE(decomposition_type), POINTER :: decomposition
3050  TYPE(decomposition_topology_type), POINTER :: decompositionTopology
3051  TYPE(domain_topology_type), POINTER :: domainTopology
3052  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
3053  TYPE(basis_type), POINTER :: elementBasis
3054  LOGICAL :: userElementExists,ghostElement
3055  INTEGER(INTG) :: dependentVarType,meshComponentNumber
3056  INTEGER(INTG) :: numberOfDimensions,numberOfXi
3057  INTEGER(INTG) :: localElementNumber,i,nh,mh
3058  REAL(DP) :: dZdNu(3,3),dZdNuT(3,3),AZL(3,3),E(3,3),cauchyStressTensor(3,3),cauchyStressVoigt(6),Jznu
3059 
3060  enters("FiniteElasticity_TensorInterpolateXi",err,error,*999)
3061 
3062  NULLIFY(equations)
3063  NULLIFY(dependentfield)
3064  NULLIFY(geometricinterpolatedpoint)
3065  NULLIFY(fibreinterpolatedpoint)
3066  NULLIFY(dependentinterpolatedpoint)
3067  NULLIFY(materialsinterpolatedpoint)
3068  NULLIFY(independentinterpolatedpoint)
3069  NULLIFY(darcyinterpolatedpoint)
3070  NULLIFY(decomposition)
3071  NULLIFY(decompositiontopology)
3072  NULLIFY(domaintopology)
3073  NULLIFY(elementbasis)
3074 
3075  IF(.NOT.ASSOCIATED(equationsset)) THEN
3076  CALL flagerror("Equations set is not associated.",err,error,*999)
3077  END IF
3078  equations=>equationsset%equations
3079  IF(.NOT.ASSOCIATED(equations)) THEN
3080  CALL flagerror("Equations set equations is not associated.",err,error,*999)
3081  END IF
3082 
3083  nonlinearmapping=>equations%equations_mapping%nonlinear_mapping
3084  IF(.NOT.ASSOCIATED(equations)) THEN
3085  CALL flagerror("Equations nonlinear mapping is not associated.",err,error,*999)
3086  END IF
3087  dependentvartype=nonlinearmapping%residual_variables(1)%ptr%variable_type
3088 
3089  IF(.NOT.ASSOCIATED(equations%interpolation)) THEN
3090  CALL flagerror("Equations interpolation is not associated.",err,error,*999)
3091  END IF
3092  dependentfield=>equations%interpolation%dependent_field
3093  IF(.NOT.ASSOCIATED(dependentfield)) THEN
3094  CALL flagerror("Equations dependent field is not associated.",err,error,*999)
3095  END IF
3096  decomposition=>dependentfield%decomposition
3097  IF(.NOT.ASSOCIATED(decomposition)) THEN
3098  CALL flagerror("Dependent field decomposition is not associated.",err,error,*999)
3099  END IF
3100  CALL decomposition_mesh_component_number_get(decomposition,meshcomponentnumber,err,error,*999)
3101  decompositiontopology=>decomposition%topology
3102  domaintopology=>decomposition%domain(meshcomponentnumber)%ptr%topology
3103  CALL decomposition_topology_element_check_exists(decompositiontopology,userelementnumber, &
3104  & userelementexists,localelementnumber,ghostelement,err,error,*999)
3105  IF(.NOT.userelementexists) THEN
3106  CALL flagerror("The specified user element number of "// &
3107  & trim(numbertovstring(userelementnumber,"*",err,error))// &
3108  & " does not exist in the decomposition for the dependent field.",err,error,*999)
3109  END IF
3110  CALL domaintopology_elementbasisget( &
3111  & domaintopology,userelementnumber,elementbasis,err,error,*999)
3112 
3113  !Get the interpolation parameters for this element
3114  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber, &
3115  & equations%interpolation%geometric_interp_parameters(field_u_variable_type)%ptr,err,error,*999)
3116  IF(ASSOCIATED(equations%interpolation%fibre_interp_parameters)) THEN
3117  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber, &
3118  & equations%interpolation%fibre_interp_parameters(field_u_variable_type)%ptr,err,error,*999)
3119  END IF
3120  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber, &
3121  & equations%interpolation%dependent_interp_parameters(dependentvartype)%ptr,err,error,*999)
3122 
3123  !Get interpolated points
3124  geometricinterpolatedpoint=>equations%interpolation%geometric_interp_point(field_u_variable_type)%ptr
3125  IF(ASSOCIATED(equations%interpolation%fibre_interp_point)) THEN
3126  fibreinterpolatedpoint=>equations%interpolation%fibre_interp_point(field_u_variable_type)%ptr
3127  END IF
3128  dependentinterpolatedpoint=>equations%interpolation%dependent_interp_point(dependentvartype)%ptr
3129 
3130  !Get interpolated point metrics
3131  geometricinterpolatedpointmetrics=>equations%interpolation% &
3132  & geometric_interp_point_metrics(field_u_variable_type)%ptr
3133  dependentinterpolatedpointmetrics=>equations%interpolation% &
3134  & dependent_interp_point_metrics(dependentvartype)%ptr
3135 
3136  !Interpolate fields at xi position
3137  CALL field_interpolate_xi(first_part_deriv,xi,dependentinterpolatedpoint,err,error,*999)
3138  CALL field_interpolate_xi(first_part_deriv,xi,geometricinterpolatedpoint,err,error,*999)
3139  IF(ASSOCIATED(fibreinterpolatedpoint)) THEN
3140  CALL field_interpolate_xi(first_part_deriv,xi,fibreinterpolatedpoint,err,error,*999)
3141  END IF
3142 
3143  !Calculate field metrics
3144  CALL field_interpolated_point_metrics_calculate( &
3145  & elementbasis%number_of_xi,geometricinterpolatedpointmetrics,err,error,*999)
3146  CALL field_interpolated_point_metrics_calculate( &
3147  & elementbasis%number_of_xi,dependentinterpolatedpointmetrics,err,error,*999)
3148 
3149  !Calculate F=dZ/dNU, the deformation gradient tensor at the xi location
3150  numberofdimensions=equationsset%region%coordinate_system%number_of_dimensions
3151  numberofxi=elementbasis%number_of_xi
3152  CALL finiteelasticity_gaussdeformationgradienttensor(dependentinterpolatedpointmetrics, &
3153  & geometricinterpolatedpointmetrics,fibreinterpolatedpoint,dzdnu,err,error,*999)
3154 
3155  IF(tensorevaluatetype==equations_set_evaluate_r_cauchy_green_deformation_tensor .OR. &
3156  & tensorevaluatetype==equations_set_evaluate_green_lagrange_strain_tensor) THEN
3157  CALL matrix_transpose(dzdnu,dzdnut,err,error,*999)
3158  CALL matrix_product(dzdnut,dzdnu,azl,err,error,*999)
3159  END IF
3160 
3161  IF(tensorevaluatetype==equations_set_evaluate_green_lagrange_strain_tensor) THEN
3162  !Calculate E
3163  e=0.5_dp*azl
3164  DO i=1,3
3165  e(i,i)=e(i,i)-0.5_dp
3166  END DO
3167  END IF
3168 
3169  IF(tensorevaluatetype==equations_set_evaluate_cauchy_stress_tensor) THEN
3170  !Get the interpolation parameters for this element
3171  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber, &
3172  & equations%interpolation%materials_interp_parameters(field_u_variable_type)%ptr,err,error,*999)
3173  IF(ASSOCIATED(equations%interpolation%independent_interp_parameters)) THEN
3174  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber, &
3175  & equations%interpolation%independent_interp_parameters(field_u_variable_type)%ptr,err,error,*999)
3176  END IF
3177 
3178  !Get interpolated points
3179  materialsinterpolatedpoint=>equations%interpolation%materials_interp_point(field_u_variable_type)%ptr
3180  IF(ASSOCIATED(equations%interpolation%independent_interp_point)) THEN
3181  independentinterpolatedpoint=>equations%interpolation%independent_interp_point(dependentvartype)%ptr
3182  END IF
3183 
3184  !Interpolate fields at xi position
3185  CALL field_interpolate_xi(no_part_deriv,xi,materialsinterpolatedpoint,err,error,*999)
3186  IF(ASSOCIATED(independentinterpolatedpoint)) THEN
3187  CALL field_interpolate_xi(first_part_deriv,xi,independentinterpolatedpoint,err,error,*999)
3188  END IF
3189 
3190  SELECT CASE(equationsset%specification(3))
3191  CASE(equations_set_mooney_rivlin_subtype)
3192  !Calculate the Cauchy stress tensor (in Voigt form) at the gauss point.
3193  jznu=dependentinterpolatedpointmetrics%JACOBIAN/geometricinterpolatedpointmetrics%JACOBIAN
3194  ! Note that some problems, e.g. active contraction, require additonal fields to be evaluated at Gauss points. This is
3195  ! currently achieved by providing the gausspoint number to the FINITE_ELASTICITY_GAUSS_STRESS_TENSOR routine.
3196  ! However, the current routine, FiniteElasticity_TensorInterpolateXi, aims to evaluate tensors as any xi, so the Gauss
3197  ! point number has been set to 0, which will generate an error for such problems.
3198  ! To address such issues, the FINITE_ELASTICITY_GAUSS_STRESS_TENSOR routine needs to be generalized to allow calculation
3199  ! of stress at any xi position and the GaussPoint number argument needs to be replace with a set of xi coordinates.
3200  CALL finite_elasticity_gauss_stress_tensor(equationsset,dependentinterpolatedpoint, &
3201  & materialsinterpolatedpoint,cauchystressvoigt,dzdnu,jznu,localelementnumber,0,err,error,*999)
3202 
3203  !Convert from Voigt form to tensor form.
3204  DO nh=1,3
3205  DO mh=1,3
3206  cauchystresstensor(mh,nh)=cauchystressvoigt(tensor_to_voigt3(mh,nh))
3207  ENDDO
3208  ENDDO
3209  CASE(equations_set_orthotropic_material_costa_subtype, equations_set_transverse_isotropic_guccione_subtype)
3210  CALL finite_elasticity_gauss_cauchy_tensor(equationsset,dependentinterpolatedpoint, &
3211  & materialsinterpolatedpoint,darcyinterpolatedpoint, &
3212  & independentinterpolatedpoint,cauchystresstensor,jznu,dzdnu,localelementnumber,0,err,error,*999)
3213  CASE DEFAULT
3214  CALL flagerror("Not implemented ",err,error,*999)
3215  END SELECT
3216  END IF
3217 
3218  SELECT CASE(tensorevaluatetype)
3219  CASE(equations_set_evaluate_deformation_gradient_tensor)
3220  values=dzdnu
3221  CASE(equations_set_evaluate_r_cauchy_green_deformation_tensor)
3222  values=azl
3223  CASE(equations_set_evaluate_green_lagrange_strain_tensor)
3224  values=e
3225  CASE(equations_set_evaluate_cauchy_stress_tensor)
3226  values=cauchystresstensor
3227  CASE(equations_set_evaluate_second_pk_stress_tensor)
3228  CALL flagerror("Not implemented.",err,error,*999)
3229  CASE DEFAULT
3230  CALL flagerror("The tensor evalaute type of "//trim(number_to_vstring(tensorevaluatetype,"*",err,error))//" is invalid "// &
3231  & "for finite elasticity equation sets",err,error,*999)
3232  END SELECT
3233 
3234  exits("FiniteElasticity_TensorInterpolateXi")
3235  RETURN
3236 999 errorsexits("FiniteElasticity_TensorInterpolateXi",err,error)
3237  RETURN 1
3238  END SUBROUTINE finiteelasticity_tensorinterpolatexi
3239 
3240  !
3241  !================================================================================================================================
3242  !
3243 
3244  !Evaluates the Jacobian surface traction (pressure) term of the equilibrium equation. Here it is assumed that pressure is constant
3245  !(if not: the jacobian has to be extended to include this) and that along the boundary of the boundary faces (the boundary line)
3246  !minimal one direction perpendicular to that boundary line is fixed, or that we have no boundary line at all (a closed body). In
3247  !these cases the jacobian is symmetrical. See Rumpel & Schweizerhof, "Hydrostatic fluid loading in non-linear finite element
3248  !analysis".
3249  SUBROUTINE finiteelasticity_surfacepressurejacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
3250  !Argument variables
3251  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3252  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
3253  INTEGER(INTG), INTENT(OUT) :: ERR
3254  TYPE(varying_string), INTENT(OUT) :: ERROR
3255  !Local variables
3256  TYPE(basis_type), POINTER :: DEPENDENT_BASIS
3257  TYPE(basis_ptr_type) :: BASES(3)
3258  TYPE(decomposition_type), POINTER :: DECOMPOSITION
3259  TYPE(decomposition_element_type), POINTER :: ELEMENT
3260  TYPE(decomposition_face_type), POINTER :: FACE
3261  TYPE(equations_type), POINTER :: EQUATIONS
3262  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3263  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
3264  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3265  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3266  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
3267  TYPE(field_interpolation_parameters_type), POINTER :: DEPENDENT_INTERPOLATION_PARAMETERS
3268  TYPE(field_interpolation_parameters_type), POINTER :: PRESSURE_INTERPOLATION_PARAMETERS
3269  TYPE(field_interpolated_point_type), POINTER :: DEPENDENT_INTERP_POINT,PRESSURE_INTERP_POINT
3270  TYPE(field_interpolated_point_metrics_type), POINTER :: DEPENDENT_INTERP_POINT_METRICS
3271  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
3272  TYPE(field_type), POINTER :: DEPENDENT_FIELD
3273  TYPE(quadrature_scheme_type), POINTER :: DEPENDENT_QUADRATURE_SCHEME
3274  TYPE(quadrature_scheme_ptr_type) :: QUADRATURE_SCHEMES(3)
3275  INTEGER(INTG) :: FACE_NUMBER,xiDirection(3),orientation
3276  INTEGER(INTG) :: FIELD_VAR_U_TYPE,FIELD_VAR_DELUDELN_TYPE,MESH_COMPONENT_NUMBER
3277  INTEGER(INTG) :: oh,mh,ms,mhs,nh,ns,nhs,ng,naf
3278  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NUMBER_OF_LOCAL_FACES
3279  INTEGER(INTG) :: SUM_ELEMENT_PARAMETERS
3280  INTEGER(INTG) :: ELEMENT_BASE_DOF_INDEX(3),NUMBER_OF_FACE_PARAMETERS(3)
3281  INTEGER(INTG), PARAMETER :: OFF_DIAG_COMP(3)=[0,1,3],off_diag_dep_var1(3)=[1,1,2],off_diag_dep_var2(3)=[2,3,3]
3282  REAL(DP) :: PRESSURE_GAUSS,GW_PRESSURE
3283  REAL(DP) :: NORMAL(3),GW_PRESSURE_W(2),TEMP3, TEMP4
3284  REAL(DP) :: TEMPVEC1(2),TEMPVEC2(2),TEMPVEC3(3),TEMPVEC4(3),TEMPVEC5(3)
3285  LOGICAL :: NONZERO_PRESSURE
3286 
3287  enters("FiniteElasticity_SurfacePressureJacobianEvaluate",err,error,*999)
3288 
3289  NULLIFY(dependent_basis)
3290  NULLIFY(decomposition)
3291  NULLIFY(element)
3292  NULLIFY(equations,equations_mapping,equations_matrices,nonlinear_mapping,nonlinear_matrices,jacobian_matrix)
3293  NULLIFY(dependent_interpolation_parameters,pressure_interpolation_parameters)
3294  NULLIFY(dependent_interp_point,dependent_interp_point_metrics,pressure_interp_point)
3295  NULLIFY(dependent_field)
3296  NULLIFY(field_variable)
3297  NULLIFY(dependent_quadrature_scheme)
3298 
3299  number_of_dimensions=equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
3300 
3301  equations=>equations_set%EQUATIONS
3302  equations_matrices=>equations%EQUATIONS_MATRICES
3303  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3304  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
3305 
3306  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
3307  decomposition=>dependent_field%DECOMPOSITION
3308  mesh_component_number=decomposition%MESH_COMPONENT_NUMBER
3309  element=>decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)
3310  number_of_local_faces=dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
3311  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS%NUMBER_OF_LOCAL_FACES
3312 
3313  field_variable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
3314  field_var_u_type=equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR%VARIABLE_TYPE
3315  field_var_deludeln_type=equations%EQUATIONS_MAPPING%RHS_MAPPING%RHS_VARIABLE_TYPE
3316 
3317  !Surface pressure term calculation: Loop over all faces
3318  DO naf=1,number_of_local_faces
3319  face_number=element%ELEMENT_FACES(naf)
3320  face=>decomposition%TOPOLOGY%FACES%FACES(face_number)
3321 
3322  !Check if it's a boundary face
3323  IF(face%BOUNDARY_FACE) THEN
3324  xidirection(3)=abs(face%XI_DIRECTION)
3325 
3326  pressure_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_deludeln_type)%PTR
3327  CALL field_interpolation_parameters_face_get(field_pressure_values_set_type,face_number, &
3328  & pressure_interpolation_parameters,err,error,*999,field_geometric_components_type)
3329  pressure_interp_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_deludeln_type)%PTR
3330 
3331  !Check if nonzero surface pressure is defined on the face
3332  nonzero_pressure=any(abs(pressure_interpolation_parameters%PARAMETERS(:,xidirection(3)))>zero_tolerance)
3333 
3334  !Nonzero surface pressure found?
3335  IF(nonzero_pressure) THEN
3336  mesh_component_number=decomposition%MESH_COMPONENT_NUMBER
3337  dependent_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%FACES%FACES(face_number)%BASIS
3338  dependent_quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3339 
3340  dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR
3341  CALL field_interpolation_parameters_face_get(field_values_set_type,face_number, &
3342  & dependent_interpolation_parameters,err,error,*999,field_geometric_components_type)
3343  dependent_interp_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_u_type)%PTR
3344  dependent_interp_point_metrics=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS(field_var_u_type)%PTR
3345 
3346  sum_element_parameters=0
3347  !Loop over geometric dependent basis functions.
3348  DO nh=1,number_of_dimensions
3349  mesh_component_number=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
3350  dependent_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%FACES%FACES(face_number)%BASIS
3351  bases(nh)%PTR=>decomposition%DOMAIN(mesh_component_number)%PTR% &
3352  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3353  quadrature_schemes(nh)%PTR=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3354  number_of_face_parameters(nh)=dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3355  element_base_dof_index(nh)=sum_element_parameters
3356  sum_element_parameters=sum_element_parameters+bases(nh)%PTR%NUMBER_OF_ELEMENT_PARAMETERS
3357  ENDDO !nh
3358 
3359  xidirection(1)=other_xi_directions3(xidirection(3),2,1)
3360  xidirection(2)=other_xi_directions3(xidirection(3),3,1)
3361  orientation=sign(1,other_xi_orientations3(xidirection(1),xidirection(2))*face%XI_DIRECTION)
3362 
3363  !Loop over all Gauss points
3364  DO ng=1,dependent_quadrature_scheme%NUMBER_OF_GAUSS
3365  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng, &
3366  & pressure_interp_point,err,error,*999,field_geometric_components_type)
3367  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng, &
3368  & dependent_interp_point,err,error,*999,field_geometric_components_type)
3369  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_area_type, &
3370  & dependent_interp_point_metrics,err,error,*999)
3371 
3372  CALL cross_product(dependent_interp_point_metrics%DX_DXI(:,1), &
3373  & dependent_interp_point_metrics%DX_DXI(:,2),normal,err,error,*999)
3374  pressure_gauss=pressure_interp_point%VALUES(xidirection(3),no_part_deriv)*orientation
3375  gw_pressure=dependent_quadrature_scheme%GAUSS_WEIGHTS(ng)*pressure_gauss
3376 
3377  DO oh=1,off_diag_comp(number_of_dimensions)
3378  nh=off_diag_dep_var1(oh)
3379  mh=off_diag_dep_var2(oh)
3380  gw_pressure_w(1:2)=(normal(mh)*dependent_interp_point_metrics%DXI_DX(1:2,nh)- &
3381  & dependent_interp_point_metrics%DXI_DX(1:2,mh)*normal(nh))*gw_pressure
3382  DO ns=1,number_of_face_parameters(nh)
3383  !Loop over element rows belonging to geometric dependent variables
3384  nhs=element_base_dof_index(nh)+ &
3385  & bases(nh)%PTR%ELEMENT_PARAMETERS_IN_LOCAL_FACE(ns,naf)
3386  tempvec1(1:2)=gw_pressure_w(1:2)*quadrature_schemes(nh)%PTR% &
3387  & gauss_basis_fns(ns,partial_derivative_first_derivative_map(1:2),ng)
3388  DO ms=1,number_of_face_parameters(mh)
3389  mhs=element_base_dof_index(mh)+ &
3390  & bases(mh)%PTR%ELEMENT_PARAMETERS_IN_LOCAL_FACE(ms,naf)
3391  tempvec2=quadrature_schemes(mh)%PTR%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
3392  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+ &
3393  & dot_product(tempvec1,tempvec2)* &
3394  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR%SCALE_FACTORS(ms,mh)* &
3395  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR%SCALE_FACTORS(ns,nh)
3396  ENDDO !ms
3397  ENDDO !ns
3398  ENDDO !oh
3399 
3400  DO oh=1,off_diag_comp(number_of_dimensions)
3401  nh=off_diag_dep_var1(oh)
3402  mh=off_diag_dep_var2(oh)
3403  gw_pressure_w(1:2)=(normal(nh)*dependent_interp_point_metrics%DXI_DX(1:2,mh)- &
3404  & dependent_interp_point_metrics%DXI_DX(1:2,nh)*normal(mh))*gw_pressure
3405  DO ms=1,number_of_face_parameters(mh)
3406  !Loop over element rows belonging to geometric dependent variables
3407  mhs=element_base_dof_index(mh)+ &
3408  & bases(mh)%PTR%ELEMENT_PARAMETERS_IN_LOCAL_FACE(ms,naf)
3409  tempvec1(1:2)=gw_pressure_w(1:2)*quadrature_schemes(mh)%PTR% &
3410  & gauss_basis_fns(ms,partial_derivative_first_derivative_map(1:2),ng)
3411  DO ns=1,number_of_face_parameters(nh)
3412  nhs=element_base_dof_index(nh)+ &
3413  & bases(nh)%PTR%ELEMENT_PARAMETERS_IN_LOCAL_FACE(ns,naf)
3414  tempvec2=quadrature_schemes(nh)%PTR%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
3415  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(nhs,mhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(nhs,mhs)+ &
3416  & dot_product(tempvec1,tempvec2)* &
3417  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR%SCALE_FACTORS(ms,mh)* &
3418  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR%SCALE_FACTORS(ns,nh)
3419  ENDDO !ns
3420  ENDDO !ms
3421  ENDDO !oh
3422  ENDDO !ng
3423  ENDIF !Non-zero pressure on face
3424  ENDIF !Boundary face
3425  ENDDO !naf
3426 
3427  exits("FiniteElasticity_SurfacePressureJacobianEvaluate")
3428  RETURN
3429 999 errors("FiniteElasticity_SurfacePressureJacobianEvaluate",err,error)
3430  exits("FiniteElasticity_SurfacePressureJacobianEvaluate")
3431  RETURN 1
3432 
3433  END SUBROUTINE finiteelasticity_surfacepressurejacobianevaluate
3434 
3435  !
3436  !================================================================================================================================
3437  !
3438 
3439  !Evaluates the surface traction (pressure) term of the equilibrium equation
3440  SUBROUTINE finiteelasticity_surfacepressureresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,var1,var2,ERR,ERROR,*)
3441  !Argument variables
3442  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3443  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
3444  INTEGER(INTG), INTENT(IN) :: var1
3445  INTEGER(INTG), INTENT(IN) :: var2
3446  INTEGER(INTG), INTENT(OUT) :: ERR
3447  TYPE(varying_string), INTENT(OUT) :: ERROR
3448  !Local variables
3449  TYPE(basis_type), POINTER :: DEPENDENT_FACE_BASIS,COMPONENT_FACE_BASIS,COMPONENT_BASIS
3450  TYPE(decomposition_type), POINTER :: DECOMPOSITION
3451  TYPE(decomposition_element_type), POINTER :: DECOMP_ELEMENT
3452  TYPE(decomposition_face_type), POINTER :: DECOMP_FACE
3453  TYPE(equations_type), POINTER :: EQUATIONS
3454  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3455  TYPE(field_type), POINTER :: DEPENDENT_FIELD
3456  TYPE(field_interpolation_parameters_type), POINTER :: FACE_DEPENDENT_INTERPOLATION_PARAMETERS
3457  TYPE(field_interpolation_parameters_type), POINTER :: FACE_PRESSURE_INTERPOLATION_PARAMETERS
3458  TYPE(field_interpolated_point_type), POINTER :: FACE_DEPENDENT_INTERPOLATED_POINT
3459  TYPE(field_interpolated_point_metrics_type), POINTER :: FACE_DEPENDENT_INTERPOLATED_POINT_METRICS
3460  TYPE(field_interpolated_point_type), POINTER :: FACE_PRESSURE_INTERPOLATED_POINT
3461  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
3462  TYPE(quadrature_scheme_type), POINTER :: FACE_QUADRATURE_SCHEME,COMPONENT_FACE_QUADRATURE_SCHEME
3463  INTEGER(INTG) :: FIELD_VAR_U_TYPE,FIELD_VAR_DUDN_TYPE,MESH_COMPONENT_NUMBER
3464  INTEGER(INTG) :: element_face_idx,face_number,gauss_idx
3465  INTEGER(INTG) :: component_idx,element_base_dof_idx,element_dof_idx,parameter_idx,face_parameter_idx
3466  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NUMBER_OF_LOCAL_FACES
3467  INTEGER(INTG) :: xiDirection(3),orientation
3468  REAL(DP) :: PRESSURE_GAUSS,GW_PRESSURE,GW_PRESSURE_NORMAL_COMPONENT
3469  REAL(DP) :: NORMAL(3)
3470  LOGICAL :: NONZERO_PRESSURE
3471 
3472  enters("FiniteElasticity_SurfacePressureResidualEvaluate",err,error,*999)
3473 
3474  NULLIFY(dependent_face_basis,component_face_basis,component_basis)
3475  NULLIFY(decomposition)
3476  NULLIFY(decomp_element)
3477  NULLIFY(decomp_face)
3478  NULLIFY(equations)
3479  NULLIFY(equations,nonlinear_matrices)
3480  NULLIFY(dependent_field,field_variable)
3481  NULLIFY(face_dependent_interpolation_parameters)
3482  NULLIFY(face_dependent_interpolated_point,face_dependent_interpolated_point_metrics)
3483  NULLIFY(face_pressure_interpolation_parameters,face_pressure_interpolated_point)
3484  NULLIFY(component_face_quadrature_scheme,face_quadrature_scheme)
3485 
3486  number_of_dimensions=equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
3487 
3488  !Grab pointers of interest
3489  equations=>equations_set%EQUATIONS
3490  nonlinear_matrices=>equations%EQUATIONS_MATRICES%NONLINEAR_MATRICES
3491  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
3492  decomposition=>dependent_field%DECOMPOSITION
3493  mesh_component_number=decomposition%MESH_COMPONENT_NUMBER
3494  decomp_element=>decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)
3495 
3496  !Interpolation parameter for metric tensor
3497  field_variable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
3498  field_var_u_type=field_variable%VARIABLE_TYPE
3499  field_var_dudn_type=equations%EQUATIONS_MAPPING%RHS_MAPPING%RHS_VARIABLE_TYPE
3500  number_of_local_faces=decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%ELEMENTS% &
3501  & elements(element_number)%BASIS%NUMBER_OF_LOCAL_FACES
3502 
3503  !Surface pressure term calculation: Loop over all faces
3504  DO element_face_idx=1,number_of_local_faces
3505  face_number=decomp_element%ELEMENT_FACES(element_face_idx)
3506  decomp_face=>decomposition%TOPOLOGY%FACES%FACES(face_number)
3507 
3508  !Check if it's a boundary face
3509  IF(decomp_face%BOUNDARY_FACE) THEN !!temporary until MESH_FACE (or equivalent) is available (decomp face includes ghost faces?)
3510  xidirection(3)=abs(decomp_face%XI_DIRECTION) ! if xi=0, this can be a negative number
3511  !Get pressure interpolation objects (DELUDELN pressure_values_set_type)
3512  face_pressure_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_dudn_type)%PTR
3513  CALL field_interpolation_parameters_face_get(field_pressure_values_set_type,face_number, &
3514  & face_pressure_interpolation_parameters,err,error,*999,field_geometric_components_type)
3515  face_pressure_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(var2)%PTR
3516 
3517  !Check if nonzero surface pressure is defined on the face
3518  nonzero_pressure=any(abs(face_pressure_interpolation_parameters%PARAMETERS(:,xidirection(3)))>zero_tolerance)
3519 
3520  !Nonzero surface pressure found?
3521  IF(nonzero_pressure) THEN
3522  !Grab some other pointers
3523  dependent_face_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%FACES%FACES(face_number)%BASIS
3524  face_quadrature_scheme=>dependent_face_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3525 
3526  face_dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_u_type)%PTR
3527  CALL field_interpolation_parameters_face_get(field_values_set_type,face_number, &
3528  & face_dependent_interpolation_parameters,err,error,*999,field_geometric_components_type)
3529  face_dependent_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_u_type)%PTR
3530  face_dependent_interpolated_point_metrics=>equations%INTERPOLATION% &
3531  & dependent_interp_point_metrics(field_var_u_type)%PTR
3532 
3533  xidirection(1)=other_xi_directions3(xidirection(3),2,1)
3534  xidirection(2)=other_xi_directions3(xidirection(3),3,1)
3535  orientation=sign(1,other_xi_orientations3(xidirection(1),xidirection(2))*decomp_face%XI_DIRECTION)
3536 
3537  !Start integrating
3538  ! Note: As the code will look for P(appl) in the *normal* component to the face, the
3539  ! initial assignment of P(appl) will have to be made appropriately during bc assignment
3540  DO gauss_idx=1,face_quadrature_scheme%NUMBER_OF_GAUSS
3541  !Interpolate p(appl) at gauss point
3542  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
3543  & face_pressure_interpolated_point,err,error,*999,field_geometric_components_type)
3544  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
3545  & face_dependent_interpolated_point,err,error,*999)
3546  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_area_type, &
3547  & face_dependent_interpolated_point_metrics,err,error,*999)
3548 
3549  CALL cross_product(face_dependent_interpolated_point_metrics%DX_DXI(:,1), &
3550  & face_dependent_interpolated_point_metrics%DX_DXI(:,2),normal,err,error,*999)
3551  pressure_gauss=face_pressure_interpolated_point%VALUES(xidirection(3),no_part_deriv)*orientation
3552  gw_pressure=face_quadrature_scheme%GAUSS_WEIGHTS(gauss_idx)*pressure_gauss
3553  element_base_dof_idx=0
3554  !Loop over 3 components
3555  DO component_idx=1,number_of_dimensions
3556  mesh_component_number=field_variable%COMPONENTS(component_idx)%MESH_COMPONENT_NUMBER
3557  component_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component_number)%PTR% &
3558  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3559  component_face_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%FACES%FACES(face_number)%BASIS
3560  component_face_quadrature_scheme=>component_face_basis% &
3561  & quadrature%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3562  gw_pressure_normal_component=gw_pressure*normal(component_idx)
3563  DO face_parameter_idx=1,component_face_basis%NUMBER_OF_ELEMENT_PARAMETERS
3564  parameter_idx=component_basis%ELEMENT_PARAMETERS_IN_LOCAL_FACE(face_parameter_idx,element_face_idx)
3565  element_dof_idx=element_base_dof_idx+parameter_idx
3566  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)= &
3567  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(element_dof_idx)+ & ! sign: double -'s. p(appl) always opposite to normal'
3568  & gw_pressure_normal_component * &
3569  & component_face_quadrature_scheme%GAUSS_BASIS_FNS(face_parameter_idx,no_part_deriv,gauss_idx)
3570  ENDDO !face_parameter_idx
3571  !Update element_base_dof_idx
3572  element_base_dof_idx=element_base_dof_idx+component_basis%NUMBER_OF_ELEMENT_PARAMETERS
3573  ENDDO !component_idx
3574  ENDDO !gauss_idx
3575  ENDIF !nonzero surface pressure check
3576  ENDIF !boundary face check
3577  ENDDO !element_face_idx
3578 
3579  exits("FiniteElasticity_SurfacePressureResidualEvaluate")
3580  RETURN
3581 999 errors("FiniteElasticity_SurfacePressureResidualEvaluate",err,error)
3582  exits("FiniteElasticity_SurfacePressureResidualEvaluate")
3583  RETURN 1
3584 
3585  END SUBROUTINE finiteelasticity_surfacepressureresidualevaluate
3586 
3587  !
3588  !================================================================================================================================
3589  !
3590 
3592  SUBROUTINE finiteelasticity_gaussdeformationgradienttensor(dependentInterpPointMetrics,geometricInterpPointMetrics,&
3593  & fibreinterpolatedpoint,dzdnu,err,error,*)
3594 
3595  !Argument variables
3596  TYPE(field_interpolated_point_metrics_type), POINTER :: dependentInterpPointMetrics,geometricInterpPointMetrics
3597  TYPE(field_interpolated_point_type), POINTER :: fibreInterpolatedPoint
3598  REAL(DP), INTENT(OUT) :: dZdNu(3,3)
3599  INTEGER(INTG), INTENT(OUT) :: err
3600  TYPE(varying_string), INTENT(OUT) :: error
3601  !Local Variables
3602  INTEGER(INTG) :: numberOfXDimensions,numberOfXiDimensions,numberOfZDimensions
3603  REAL(DP) :: dNuDXi(3,3),dXidNu(3,3), dNudX(3,3),dXdNu(3,3)
3604 
3605  enters("FiniteElasticity_GaussDeformationGradientTensor",err,error,*999)
3606 
3607  IF(ASSOCIATED(dependentinterppointmetrics)) THEN
3608  IF(ASSOCIATED(geometricinterppointmetrics)) THEN
3609  numberofxdimensions=geometricinterppointmetrics%NUMBER_OF_X_DIMENSIONS
3610  numberofxidimensions=geometricinterppointmetrics%NUMBER_OF_XI_DIMENSIONS
3611  numberofzdimensions=dependentinterppointmetrics%NUMBER_OF_X_DIMENSIONS
3612 
3613  CALL coordinates_materialsystemcalculate(geometricinterppointmetrics,fibreinterpolatedpoint,dnudx,dxdnu, &
3614  & dnudxi(1:numberofxdimensions,1:numberofxidimensions), &
3615  & dxidnu(1:numberofxidimensions,1:numberofxdimensions),err,error,*999)
3616  !dZ/dNu = dZ/dXi * dXi/dNu (deformation gradient tensor, F)
3617  CALL matrixproduct(dependentinterppointmetrics%DX_DXI(1:numberofzdimensions,1:numberofxidimensions), &
3618  & dxidnu(1:numberofxidimensions,1:numberofxdimensions),dzdnu(1:numberofzdimensions,1:numberofxdimensions), &
3619  & err,error,*999)
3620 
3621  IF(numberofzdimensions == 2) THEN
3622  dzdnu(:,3) = [0.0_dp,0.0_dp,1.0_dp]
3623  dzdnu(3,1:2) = 0.0_dp
3624  ENDIF
3625 
3626  IF(diagnostics1) THEN
3627  CALL writestring(diagnostic_output_type,"",err,error,*999)
3628  CALL writestring(diagnostic_output_type,"Calculated deformation gradient tensor:",err,error,*999)
3629  CALL writestringvalue(diagnostic_output_type," Number of Z dimensions = ",numberofzdimensions,err,error,*999)
3630  CALL writestringvalue(diagnostic_output_type," Number of Xi dimensions = ",numberofxidimensions,err,error,*999)
3631  CALL writestringmatrix(diagnostic_output_type,1,1,numberofxdimensions,1,1,numberofxdimensions, &
3632  & numberofxdimensions,numberofxdimensions,dzdnu,write_string_matrix_name_and_indices, &
3633  & '(" dZdNu','(",I1,",:)',' :",3(X,E13.6))','(15X,3(X,E13.6))',err,error,*999)
3634  ENDIF
3635 
3636  ELSE
3637  CALL flagerror("Geometric interpolated point metrics is not associated.",err,error,*999)
3638  ENDIF
3639  ELSE
3640  CALL flagerror("Dependent interpolated point metrics is not associated.",err,error,*999)
3641  ENDIF
3642 
3643  exits("FiniteElasticity_GaussDeformationGradientTensor")
3644  RETURN
3645 999 errors("FiniteElasticity_GaussDeformationGradientTensor",err,error)
3646  exits("FiniteElasticity_GaussDeformationGradientTensor")
3647  RETURN 1
3648 
3649  END SUBROUTINE finiteelasticity_gaussdeformationgradienttensor
3650 
3651  !
3652  !================================================================================================================================
3653  !
3654 
3656  SUBROUTINE finite_elasticity_gauss_cauchy_tensor(EQUATIONS_SET,DEPENDENT_INTERPOLATED_POINT, &
3657  & materials_interpolated_point,darcy_dependent_interpolated_point, &
3658  & independent_interpolated_point,cauchy_tensor,jznu,dzdnu,element_number,gauss_point_number,err,error,*)
3659 
3660  !Argument variables
3661  TYPE(equations_set_type), POINTER, INTENT(IN) :: EQUATIONS_SET
3662  TYPE(field_interpolated_point_type), POINTER :: DEPENDENT_INTERPOLATED_POINT,MATERIALS_INTERPOLATED_POINT
3663  TYPE(field_interpolated_point_type), POINTER :: DARCY_DEPENDENT_INTERPOLATED_POINT
3664  TYPE(field_interpolated_point_type), POINTER :: INDEPENDENT_INTERPOLATED_POINT
3665  REAL(DP), INTENT(OUT) :: CAUCHY_TENSOR(:,:)
3666  REAL(DP), INTENT(OUT) :: Jznu !Determinant of deformation gradient tensor (AZL)
3667  REAL(DP), INTENT(IN) :: DZDNU(3,3) !Deformation gradient tensor at the Guass point
3668  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER,GAUSS_POINT_NUMBER
3669  INTEGER(INTG), INTENT(OUT) :: ERR
3670  TYPE(varying_string), INTENT(OUT) :: ERROR
3671  !Local Variables
3672  INTEGER(INTG) :: EQUATIONS_SET_SUBTYPE
3673  INTEGER(INTG) :: i,j,k,PRESSURE_COMPONENT,component_idx,dof_idx
3674  REAL(DP) :: activation
3675  REAL(DP) :: AZL(3,3),AZU(3,3),DZDNUT(3,3),PIOLA_TENSOR(3,3),E(3,3),P,IDENTITY(3,3),AZLT(3,3),AZUT(3,3)
3676  REAL(DP) :: AZL_SQUARED(3,3)
3677  REAL(DP) :: I1,I2,I3 !Invariants, if needed
3678  REAL(DP) :: ACTIVE_STRESS_11,ACTIVE_STRESS_22,ACTIVE_STRESS_33 !Active stress to be copied in from independent field.
3679  REAL(DP) :: TEMP(3,3),TEMPTERM !Temporary variables
3680  TYPE(varying_string) :: LOCAL_ERROR
3681  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
3682  REAL(DP), DIMENSION (:), POINTER :: C !Parameters for constitutive laws
3683  REAL(DP) :: a, B(3,3), Q !Parameters for orthotropic laws
3684  REAL(DP) :: ffact,dfdJfact !coupled elasticity Darcy
3685  INTEGER(INTG) :: DARCY_MASS_INCREASE_ENTRY !position of mass-increase entry in dependent-variable vector
3686  REAL(DP) :: VALUE,VAL1,VAL2
3687  REAL(DP) :: WV_PRIME,TOL,TOL1,UP,LOW
3688  REAL(DP) :: F_e(3,3),F_a(3,3),F_a_inv(3,3),F_a_T(3,3),C_a(3,3),C_a_inv(3,3),lambda_a,C_e(3,3),F_e_T(3,3)
3689  REAL(DP) :: REFERENCE_VOLUME,XB_STIFFNESS,XB_DISTORTION,V_MAX
3690  REAL(DP) :: SARCO_LENGTH,FREE_ENERGY,FREE_ENERGY_0,XB_ENERGY_PER_VOLUME,SLOPE,lambda_f,A_1,A_2,x_1,x_2
3691  REAL(DP) :: MAX_XB_NUMBER_PER_VOLUME,ENERGY_PER_XB,FORCE_LENGTH,I_1e,EVALUES(3),EVECTOR_1(3),EVECTOR_2(3),EVECTOR_3(3)
3692  REAL(DP) :: EMATRIX_1(3,3),EMATRIX_2(3,3),EMATRIX_3(3,3),TEMP1(3,3),TEMP2(3,3),TEMP3(3,3),N1(3,3),N2(3,3),N3(3,3)
3693  REAL(DP), DIMENSION(5) :: PAR
3694  INTEGER(INTG) :: LWORK,node1,node2
3695  INTEGER(INTG), PARAMETER :: LWMAX=1000
3696  REAL(DP) :: WORK(lwmax),RIGHT_NODE(3),LEFT_NODE(3),delta_t,dist1,dist2,velo
3697  TYPE(field_type), POINTER :: DEPENDENT_FIELD,INDEPENDENT_FIELD
3698  REAL(DP) :: ISOMETRIC_FORCE_AT_FULL_ACT,LENGTH_HALF_SARCO
3699  REAL(DP) :: TITIN_VALUE,TITIN_VALUE_CROSS_FIBRE,TITIN_UNBOUND,TITIN_BOUND
3700  REAL(DP) :: TITIN_UNBOUND_CROSS_FIBRE,TITIN_BOUND_CROSS_FIBRE
3701 
3702  enters("FINITE_ELASTICITY_GAUSS_CAUCHY_TENSOR",err,error,*999)
3703 
3704  NULLIFY(field_variable)
3705 
3706  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
3707  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
3708  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
3709  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
3710  & err,error,*999)
3711  END IF
3712  equations_set_subtype=equations_set%SPECIFICATION(3)
3713  c=>materials_interpolated_point%VALUES(:,1)
3714 
3715  !AZL = F'*F (deformed covariant or right cauchy deformation tensor, C)
3716  !AZU - deformed contravariant tensor; I3 = det(C)
3717  !E = Green-Lagrange strain tensor = 0.5*(C-I)
3718  !PIOLA_TENSOR is the second Piola-Kirchoff tensor (PK2 or S)
3719  !P is the actual hydrostatic pressure, not double it
3720 
3721  CALL matrix_transpose(dzdnu,dzdnut,err,error,*999)
3722  CALL matrix_product(dzdnut,dzdnu,azl,err,error,*999)
3723  jznu = determinant(dzdnu,err,error)
3724 
3725  pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE%NUMBER_OF_COMPONENTS
3726  p=dependent_interpolated_point%VALUES(pressure_component,1)
3727 
3728  CALL invert(azl,azu,i3,err,error,*999)
3729 
3730  e = 0.5_dp*azl
3731  DO i=1,3
3732  e(i,i)=e(i,i)-0.5_dp
3733  ENDDO
3734  IF(diagnostics1) THEN
3735  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
3736  & 3,3,e,write_string_matrix_name_and_indices,'(" E','(",I1,",:)',' :",3(X,E13.6))', &
3737  & '(17X,3(X,E13.6))',err,error,*999)
3738  ENDIF
3739  identity=0.0_dp
3740  DO i=1,3
3741  identity(i,i)=1.0_dp
3742  ENDDO
3743 
3744  SELECT CASE(equations_set_subtype)
3745  CASE(equations_set_nearly_incompressible_mooney_rivlin_subtype)
3746  !Form of constitutive model is:
3747  ! W_hat=c1*(I1_hat-3)+c2*(I2_hat-3)+p*J*C^(-1) + W^v(J)
3748  ! take W^v(J) = 1/2 * kappa * (J-1)^2
3749  wv_prime = c(3)*(jznu - 1.0_dp)
3750  !compute the invariants, I3 a few lines up
3751  i1 = azl(1,1) + azl(2,2) + azl(3,3)
3752  CALL matrix_product(azl,azl,azl_squared,err,error,*999)
3753  i2 = 0.5_dp * (i1**2 - azl_squared(1,1) - azl_squared(2,2) - azl_squared(3,3))
3754 
3755  piola_tensor=2.0_dp*jznu**(-2.0_dp/3.0_dp)*((c(1)+c(2)*i1)*identity-c(2)*azl &
3756  & -(c(1)*i1+2.0_dp*c(2)*i2-1.5_dp*wv_prime*jznu**(5.0_dp/3.0_dp))/3.0_dp*azu)
3757 
3758  CASE(equations_set_incompressible_mooney_rivlin_subtype)
3759  !Form of constitutive model is:
3760  ! W_hat=c1*(I1_hat-3)+c2*(I2_hat-3)+p*J*C^(-1)
3761 
3762  !compute the invariants, I3 a few lines up
3763  i1 = azl(1,1) + azl(2,2) + azl(3,3)
3764  CALL matrix_product(azl,azl,azl_squared,err,error,*999)
3765  i2 = 0.5_dp * (i1**2 - azl_squared(1,1) - azl_squared(2,2) - azl_squared(3,3))
3766 
3767  !compute 2PK
3768 ! PIOLA_TENSOR(1,1) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (C(1) + C(2) * I1 - C(2) * AZL(1,1) &
3769 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(1,1))
3770 ! PIOLA_TENSOR(1,2) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (-C(2) * AZL(1,2) &
3771 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(1,2))
3772 ! PIOLA_TENSOR(1,3) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (-C(2) * AZL(1,3) &
3773 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(1,3))
3774 ! PIOLA_TENSOR(2,1) = PIOLA_TENSOR(1,2)
3775 ! PIOLA_TENSOR(2,2) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (C(1) + C(2) * I1 - C(2) * AZL(2,2) &
3776 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(2,2))
3777 ! PIOLA_TENSOR(2,3) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (-C(2) * AZL(2,3) &
3778 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(2,3))
3779 ! PIOLA_TENSOR(3,1) = PIOLA_TENSOR(1,3)
3780 ! PIOLA_TENSOR(3,2) = PIOLA_TENSOR(2,3)
3781 ! PIOLA_TENSOR(3,3) = 2.0_DP * Jznu**(-2.0_DP/3.0_DP) * (C(1) + C(2) * I1 - C(2) * AZL(3,3) &
3782 ! & - (C(1) * I1 + 2.0_DP * C(2) * I2 - 1.5_DP * P * Jznu**(5.0_DP/3.0_DP)) / 3.0_DP * AZU(3,3))
3783  !????
3784  piola_tensor=2.0_dp*jznu**(-2.0_dp/3.0_dp)*((c(1)+c(2)*i1)*identity-c(2)*azl &
3785  & -(c(1)*i1+2.0_dp*c(2)*i2-1.5_dp*p*jznu**(5.0_dp/3.0_dp))/3.0_dp*azu)
3786 
3787  CASE(equations_set_active_strain_subtype)
3788 
3789  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
3790  node1=dependent_field%decomposition%domain(1)%ptr%topology%elements%elements(element_number)%element_nodes(13)
3791  node2=dependent_field%decomposition%domain(1)%ptr%topology%elements%elements(element_number)%element_nodes(15)
3792 
3793  NULLIFY(field_variable)
3794  ! compute the nodal distance of the previous time step
3795  CALL field_variable_get(dependent_field,field_v_variable_type,field_variable,err,error,*999)
3796  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3797  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(1), &
3798  & err,error,*999)
3799  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3800  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(2), &
3801  & err,error,*999)
3802  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3803  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(3), &
3804  & err,error,*999)
3805 
3806  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3807  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(1), &
3808  & err,error,*999)
3809  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3810  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(2), &
3811  & err,error,*999)
3812  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3813  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(3), &
3814  & err,error,*999)
3815 
3816  dist1=sqrt((right_node(1)-left_node(1))*(right_node(1)-left_node(1))+ &
3817  & (right_node(2)-left_node(2))*(right_node(2)-left_node(2))+ &
3818  & (right_node(3)-left_node(3))*(right_node(3)-left_node(3)))
3819 
3820  NULLIFY(field_variable)
3821  ! compute the nodal distance of the current time step
3822  CALL field_variable_get(dependent_field,field_u_variable_type,field_variable,err,error,*999)
3823  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3824  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(1), &
3825  & err,error,*999)
3826  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3827  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(2), &
3828  & err,error,*999)
3829  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
3830  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(3), &
3831  & err,error,*999)
3832 
3833  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3834  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(1), &
3835  & err,error,*999)
3836  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3837  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(2), &
3838  & err,error,*999)
3839  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
3840  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(3), &
3841  & err,error,*999)
3842 
3843  dist2=sqrt((right_node(1)-left_node(1))*(right_node(1)-left_node(1))+ &
3844  & (right_node(2)-left_node(2))*(right_node(2)-left_node(2))+ &
3845  & (right_node(3)-left_node(3))*(right_node(3)-left_node(3)))
3846 
3847  delta_t=0.01_dp;
3848  velo=(dist2-dist1)/delta_t ! velo>0 for lengthening
3849 ! velo=(dist1-dist2)/delta_t ! velo<0 for shortening
3850  !velo=velo*1.0e-6_DP
3851  velo=velo*5.0e-8_dp
3852 
3853  !--------------------------------------------------------------------------------------------
3854 
3855  !Force-Velocity-Relation
3856 ! PAR=[1.0_DP,0.5_DP,0.5_DP,0.8_DP,0.2_DP] ! Muscle-Parameters for F-v-Relation
3857 ! IF(velo.GE.0.0_DP) THEN
3858 ! ENERGY_PER_XB=(PAR(1)+PAR(2))*PAR(3)/(velo+PAR(3))-PAR(2)
3859 ! ELSE
3860 ! ENERGY_PER_XB=((2.0_DP*PAR(1)-PAR(4))*velo-PAR(1)*PAR(5))/(velo-PAR(5))
3861 ! ENDIF
3862  v_max=8.9e-8_dp
3863  xb_distortion=8.0e-9_dp*(1+velo/v_max) ! [m]
3864 
3865  xb_stiffness=2.2e-3_dp ! [N/m]
3866 
3867  reference_volume=1.4965e+06_dp ! [nm^3]
3868  max_xb_number_per_volume=120.0_dp*2.0_dp/reference_volume ! [cross-bridges per nm^3]
3869  energy_per_xb=0.5_dp*xb_stiffness*xb_distortion**2 ! [J]
3870 
3871  sarco_length=dzdnu(1,1)
3872 
3873  ! Calculate Filament-Overlap
3874  IF(sarco_length.LE.0.635_dp) THEN
3875  force_length=0.0_dp
3876  ELSE IF(sarco_length.LE.0.835_dp) THEN
3877  force_length=4.2_dp*(sarco_length-0.635_dp)
3878  ELSE IF(sarco_length.LE.1.0_dp) THEN
3879  force_length=0.84_dp+0.9697_dp*(sarco_length-0.835_dp)
3880  ELSE IF(sarco_length.LE.1.125_dp) THEN
3881  force_length=1.0_dp
3882  ELSE IF(sarco_length.LE.1.825_dp) THEN
3883  force_length=1.0_dp-1.4286_dp*(sarco_length-1.125_dp)
3884  ELSE
3885  force_length=0.0_dp
3886  ENDIF
3887 
3888  !Mechanical Energy stored in cross-bridges [10^4 J per cubic meter] = [N/cm^2]
3889  xb_energy_per_volume=max_xb_number_per_volume*force_length*c(8)*energy_per_xb*10.0_dp**23 ! [10^4 J per cubic meter]
3890  !XB_ENERGY_PER_VOLUME=0.16_DP*C(8)
3891  !WRITE(*,*) XB_ENERGY_PER_VOLUME
3892 
3893  !Initalize lambda_a
3894  lambda_a=1.0_dp
3895 
3896  f_a_inv=0.0_dp
3897  f_a_inv(1,1)=1.0_dp/lambda_a
3898  f_a_inv(2,2)=1.0_dp
3899  f_a_inv(3,3)=1.0_dp
3900 
3901  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
3902  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
3903  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
3904 
3905  !Neo-Hook Material
3906 ! I_1e=C_e(1,1)+C_e(2,2)+C_e(3,3)
3907 ! FREE_ENERGY_0=1.0_DP/2.0_DP*C(1)*(I_1e-3.0_DP)
3908 
3909  !Odgen law - 3 terms. Material Parameters C = [mu(1) mu(2) mu(3) alpha(1) alpha(2) alpha(3) mu_0 XB]
3910 
3911 ! CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
3912  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
3913  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
3914  lwork=min(lwmax,int(work(1)))
3915  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
3916  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
3917  evector_1=c_e(:,1)
3918  evector_2=c_e(:,2)
3919  evector_3=c_e(:,3)
3920 
3921  DO i=1,3
3922  DO j=1,3
3923  ematrix_1(i,j)=evector_1(i)*evector_1(j)
3924  ematrix_2(i,j)=evector_2(i)*evector_2(j)
3925  ematrix_3(i,j)=evector_3(i)*evector_3(j)
3926  END DO
3927  END DO
3928 
3929  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
3930  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
3931  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
3932  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
3933  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
3934  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
3935 
3936  free_energy_0=0.0_dp
3937  DO i=1,3
3938  free_energy_0=free_energy_0+c(i)/c(i+3)*( &
3939  & evalues(1)**(c(i+3)/2.0_dp)+ &
3940  & evalues(2)**(c(i+3)/2.0_dp)+ &
3941  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
3942  END DO
3943  free_energy_0=c(7)*free_energy_0
3944 
3945  free_energy=free_energy_0
3946 
3947  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
3948  !VALUE=0.0_DP
3949 
3950  tol=0.00001_dp
3951  tol1=tol !0.05_DP
3952  up=lambda_a !1.0_DP
3953  low=0.001_dp
3954 
3955  DO WHILE (abs(VALUE).GE.tol)
3956 
3957  IF (abs(VALUE).GE.tol1) THEN
3958  lambda_a=up-(up-low)/2.0_dp
3959 
3960  f_a_inv=0.0_dp
3961  f_a_inv(1,1)=1.0_dp/lambda_a
3962  f_a_inv(2,2)=1.0_dp
3963  f_a_inv(3,3)=1.0_dp
3964 
3965  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
3966  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
3967  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
3968 
3969 ! I_1e=C_e(1,1)+C_e(2,2)+C_e(3,3)
3970 ! FREE_ENERGY=1.0_DP/2.0_DP*(I_1e-3.0_DP)
3971 ! CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
3972  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
3973  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
3974  lwork=min(lwmax,int(work(1)))
3975  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
3976  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
3977  evector_1=c_e(:,1)
3978  evector_2=c_e(:,2)
3979  evector_3=c_e(:,3)
3980 
3981  DO i=1,3
3982  DO j=1,3
3983  ematrix_1(i,j)=evector_1(i)*evector_1(j)
3984  ematrix_2(i,j)=evector_2(i)*evector_2(j)
3985  ematrix_3(i,j)=evector_3(i)*evector_3(j)
3986  END DO
3987  END DO
3988 
3989  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
3990  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
3991  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
3992  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
3993  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
3994  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
3995 
3996  free_energy=0.0_dp
3997  DO i=1,3
3998  free_energy=free_energy+c(i)/c(i+3)*( &
3999  & evalues(1)**(c(i+3)/2.0_dp)+ &
4000  & evalues(2)**(c(i+3)/2.0_dp)+ &
4001  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
4002  END DO
4003  free_energy=c(7)*free_energy
4004 
4005  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
4006 
4007  IF (VALUE .GE. 0.0_dp) THEN
4008  up=lambda_a
4009  ELSE
4010  low=lambda_a
4011  ENDIF
4012 
4013  ELSE
4014 
4015  temp=dzdnu+dzdnut
4016  CALL matrix_product(f_e_t,temp,temp,err,error,*999)
4017  CALL matrix_product(temp,n1,temp1,err,error,*999)
4018  CALL matrix_product(temp,n2,temp2,err,error,*999)
4019  CALL matrix_product(temp,n3,temp3,err,error,*999)
4020 
4021  temp=0.0_dp
4022  DO i=1,3
4023  temp=temp+ &
4024  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*temp1+ &
4025  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*temp2+ &
4026  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*temp3
4027  END DO
4028  slope=temp(1,1)*c(7)
4029  lambda_a=lambda_a-VALUE/slope
4030  !IF (lambda_a.LE.0.0_DP) THEN
4031  ! lambda_a=0.1_DP
4032  !END IF
4033  !lambda_a=lambda_a-0.001
4034 
4035  f_a_inv=0.0_dp
4036  f_a_inv(1,1)=1.0_dp/lambda_a
4037  f_a_inv(2,2)=1.0_dp
4038  f_a_inv(3,3)=1.0_dp
4039 
4040  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
4041  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
4042  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
4043 
4044 ! I_1e=C_e(1,1)+C_e(2,2)+C_e(3,3)
4045 ! FREE_ENERGY=1.0_DP/2.0_DP*(I_1e-3.0_DP)
4046 ! CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
4047  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
4048  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4049  lwork=min(lwmax,int(work(1)))
4050  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
4051  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4052  evector_1=c_e(:,1)
4053  evector_2=c_e(:,2)
4054  evector_3=c_e(:,3)
4055 
4056  DO i=1,3
4057  DO j=1,3
4058  ematrix_1(i,j)=evector_1(i)*evector_1(j)
4059  ematrix_2(i,j)=evector_2(i)*evector_2(j)
4060  ematrix_3(i,j)=evector_3(i)*evector_3(j)
4061  END DO
4062  END DO
4063 
4064  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
4065  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
4066  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
4067  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
4068  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
4069  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
4070 
4071  free_energy=0.0_dp
4072  DO i=1,3
4073  free_energy=free_energy+c(i)/c(i+3)*( &
4074  & evalues(1)**(c(i+3)/2.0_dp)+ &
4075  & evalues(2)**(c(i+3)/2.0_dp)+ &
4076  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
4077  END DO
4078  free_energy=c(7)*free_energy
4079 
4080  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
4081  ENDIF
4082  ENDDO
4083 
4084  ! Neo-Hook
4085 ! F_a = 0.0_DP
4086 ! F_a(1,1) = lambda_a
4087 ! F_a(2,2) = 1.0_DP
4088 ! F_a(3,3) = 1.0_DP
4089 ! CALL MATRIX_TRANSPOSE(F_a,F_a_T,ERR,ERROR,*999)
4090 ! CALL MATRIX_PRODUCT(F_a_T,F_a,C_a,ERR,ERROR,*999)
4091 ! CALL INVERT(C_a,C_a_inv,a,ERR,ERROR,*999) !a is not required (=1/lambda_a^2 ?)
4092 ! PIOLA_TENSOR=C(1)*C_a_inv+2.0_DP*P*AZU
4093 
4094  !Odgen
4095 ! CALL Eigenvector(C_e,EVALUES(1),EVECTOR_1,ERR,ERROR,*999)
4096 ! CALL Eigenvector(C_e,EVALUES(2),EVECTOR_2,ERR,ERROR,*999)
4097 ! CALL Eigenvector(C_e,EVALUES(3),EVECTOR_3,ERR,ERROR,*999)
4098 ! CALL MATRIX_PRODUCT(F_e_T,F_e,C_e,ERR,ERROR,*999)
4099 ! CALL DSYEV('V','U',3,C_e,3,EVALUES,WORK,-1,ERR)
4100 ! IF(ERR.NE.0) CALL FlagError("Error in Eigenvalue computation",ERR,ERROR,*999)
4101 ! LWORK=MIN(LWMAX,INT(WORK(1)))
4102 ! CALL DSYEV('V','U',3,C_e,3,EVALUES,WORK,LWORK,ERR)
4103 ! IF(ERR.NE.0) CALL FlagError("Error in Eigenvalue computation",ERR,ERROR,*999)
4104 ! EVECTOR_1=C_e(:,1)
4105 ! EVECTOR_2=C_e(:,2)
4106 ! EVECTOR_3=C_e(:,3)
4107 
4108 ! DO i=1,3
4109 ! DO j=1,3
4110 ! EMATRIX_1(i,j)=EVECTOR_1(i)*EVECTOR_1(j)
4111 ! EMATRIX_2(i,j)=EVECTOR_2(i)*EVECTOR_2(j)
4112 ! EMATRIX_3(i,j)=EVECTOR_3(i)*EVECTOR_3(j)
4113 ! END DO
4114 ! END DO
4115 
4116 ! CALL MATRIX_TRANSPOSE(F_a_inv,F_a_inv_T,ERR,ERROR,*999)
4117 
4118 ! CALL MATRIX_PRODUCT(F_a_inv,EMATRIX_1,TEMP1,ERR,ERROR,*999)
4119 ! CALL MATRIX_PRODUCT(TEMP1,F_a_inv_T,TEMP1,ERR,ERROR,*999)
4120 
4121 ! CALL MATRIX_PRODUCT(F_a_inv,EMATRIX_2,TEMP2,ERR,ERROR,*999)
4122 ! CALL MATRIX_PRODUCT(TEMP2,F_a_inv_T,TEMP2,ERR,ERROR,*999)
4123 
4124 ! CALL MATRIX_PRODUCT(F_a_inv,EMATRIX_3,TEMP3,ERR,ERROR,*999)
4125 ! CALL MATRIX_PRODUCT(TEMP3,F_a_inv_T,TEMP3,ERR,ERROR,*999)
4126 
4127  piola_tensor=0.0_dp
4128  DO i=1,3
4129  piola_tensor=piola_tensor+ &
4130  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*n1+ &
4131  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*n2+ &
4132  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*n3
4133  END DO
4134  piola_tensor=piola_tensor*c(7)+2.0_dp*p*azu
4135 
4136 
4137  CASE(equations_set_multiscale_active_strain_subtype)
4138 
4139  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4140  node1=dependent_field%decomposition%domain(1)%ptr%topology%elements%elements(element_number)%element_nodes(13)
4141  node2=dependent_field%decomposition%domain(1)%ptr%topology%elements%elements(element_number)%element_nodes(15)
4142 
4143  NULLIFY(field_variable)
4144  ! compute the nodal distance of the previous time step
4145  CALL field_variable_get(dependent_field,field_v_variable_type,field_variable,err,error,*999)
4146  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4147  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(1), &
4148  & err,error,*999)
4149  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4150  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(2), &
4151  & err,error,*999)
4152  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4153  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,left_node(3), &
4154  & err,error,*999)
4155 
4156  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4157  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(1), &
4158  & err,error,*999)
4159  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4160  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(2), &
4161  & err,error,*999)
4162  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4163  CALL field_parameter_set_get_local_dof(dependent_field,field_v_variable_type,field_values_set_type,dof_idx,right_node(3), &
4164  & err,error,*999)
4165 
4166  dist1=sqrt((right_node(1)-left_node(1))*(right_node(1)-left_node(1))+ &
4167  & (right_node(2)-left_node(2))*(right_node(2)-left_node(2))+ &
4168  & (right_node(3)-left_node(3))*(right_node(3)-left_node(3)))
4169 
4170  NULLIFY(field_variable)
4171  ! compute the nodal distance of the current time step
4172  CALL field_variable_get(dependent_field,field_u_variable_type,field_variable,err,error,*999)
4173  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4174  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(1), &
4175  & err,error,*999)
4176  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4177  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(2), &
4178  & err,error,*999)
4179  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node1)%DERIVATIVES(1)%VERSIONS(1)
4180  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,left_node(3), &
4181  & err,error,*999)
4182 
4183  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4184  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(1), &
4185  & err,error,*999)
4186  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4187  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(2), &
4188  & err,error,*999)
4189  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node2)%DERIVATIVES(1)%VERSIONS(1)
4190  CALL field_parameter_set_get_local_dof(dependent_field,field_u_variable_type,field_values_set_type,dof_idx,right_node(3), &
4191  & err,error,*999)
4192 
4193  dist2=sqrt((right_node(1)-left_node(1))*(right_node(1)-left_node(1))+ &
4194  & (right_node(2)-left_node(2))*(right_node(2)-left_node(2))+ &
4195  & (right_node(3)-left_node(3))*(right_node(3)-left_node(3)))
4196 
4197  delta_t=0.001_dp;
4198  velo=(dist2-dist1)/delta_t ! velo>0 == lengthening
4199  !conversion of velocity at the continuum macroscale to the micromechanical cell model half-sarcomere velocity
4200  velo=velo*5.0e-8_dp
4201 ! velo=velo*5.0e-2_DP
4202 ! velo=velo*5.0e-7_DP
4203 
4204  CALL field_parameter_set_update_gauss_point(dependent_field,field_u1_variable_type,field_values_set_type,gauss_point_number, &
4205  & element_number,2,velo,err,error,*999)
4206 
4207 
4208  !--------------------------------------------------------------------------------------------
4209  NULLIFY(independent_field)
4210  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
4211  NULLIFY(field_variable)
4212  CALL field_variable_get(independent_field,field_u_variable_type,field_variable,err,error,*999)
4213 
4214  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4215  & element_number)
4216  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type,dof_idx,a_1, &
4217  & err,error,*999)
4218  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4219  & element_number)
4220  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type,dof_idx,a_2, &
4221  & err,error,*999)
4222  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4223  & element_number)
4224  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type,dof_idx,x_1, &
4225  & err,error,*999)
4226  dof_idx=field_variable%COMPONENTS(4)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4227  & element_number)
4228  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type,dof_idx,x_2, &
4229  & err,error,*999)
4230 
4231  !--------------------------------------------------------------------------------------------
4232  sarco_length=dzdnu(1,1)
4233  ! Calculate Filament-Overlap
4234  IF(sarco_length.LE.0.635_dp) THEN
4235  force_length=0.0_dp
4236  ELSE IF(sarco_length.LE.0.835_dp) THEN
4237  force_length=4.2_dp*(sarco_length-0.635_dp)
4238  ELSE IF(sarco_length.LE.1.0_dp) THEN
4239  force_length=0.84_dp+0.9697_dp*(sarco_length-0.835_dp)
4240  ELSE IF(sarco_length.LE.1.125_dp) THEN
4241  force_length=1.0_dp
4242  ELSE IF(sarco_length.LE.1.825_dp) THEN
4243  force_length=1.0_dp-1.4286_dp*(sarco_length-1.125_dp)
4244  ELSE
4245  force_length=0.0_dp
4246  ENDIF
4247 
4248  reference_volume=1.4965e+06_dp ! [nm^3]
4249  max_xb_number_per_volume=120.0_dp*2.0_dp/reference_volume ! [cross-bridges per nm^3]
4250  energy_per_xb=0.5_dp*x_2**2*c(8) ! joule
4251 
4252  !Mechanical Energy stored in cross-bridges - conversion from J/nm^3 to N/cm^2
4253  xb_energy_per_volume=max_xb_number_per_volume*force_length*energy_per_xb*a_2*10.0_dp**23
4254 
4255  !Initalize lambda_a
4256  lambda_a=1.0_dp
4257 
4258  f_a_inv=0.0_dp
4259  f_a_inv(1,1)=1.0_dp/lambda_a
4260  f_a_inv(2,2)=1.0_dp
4261  f_a_inv(3,3)=1.0_dp
4262 
4263  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
4264  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
4265  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
4266 
4267  !Odgen law - 3 terms. Material Parameters C = [mu(1) mu(2) mu(3) alpha(1) alpha(2) alpha(3) mu_0]
4268 ! CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
4269  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
4270  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4271  lwork=min(lwmax,int(work(1)))
4272  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
4273  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4274  evector_1=c_e(:,1)
4275  evector_2=c_e(:,2)
4276  evector_3=c_e(:,3)
4277 
4278  DO i=1,3
4279  DO j=1,3
4280  ematrix_1(i,j)=evector_1(i)*evector_1(j)
4281  ematrix_2(i,j)=evector_2(i)*evector_2(j)
4282  ematrix_3(i,j)=evector_3(i)*evector_3(j)
4283  END DO
4284  END DO
4285 
4286  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
4287  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
4288  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
4289  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
4290  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
4291  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
4292 
4293  free_energy_0=0.0_dp
4294  DO i=1,3
4295  free_energy_0=free_energy_0+c(i)/c(i+3)*( &
4296  & evalues(1)**(c(i+3)/2.0_dp)+ &
4297  & evalues(2)**(c(i+3)/2.0_dp)+ &
4298  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
4299  END DO
4300  free_energy_0=c(7)*free_energy_0
4301 
4302  free_energy=free_energy_0
4303 
4304  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
4305 
4306  !tolerance for Newton's method
4307  tol=0.00001_dp
4308  !tolerance for the bisection method as preconditioner. Since Newton's method does not converge, we only use the bisection method here
4309  tol1=tol
4310  up=lambda_a
4311  low=0.001_dp
4312 
4313 ! WRITE(*,*) "VALUE: ", VALUE
4314 
4315  DO WHILE (abs(VALUE).GE.tol)
4316 
4317  !bisection method
4318  IF (abs(VALUE).GE.tol1) THEN
4319  lambda_a=up-(up-low)/2.0_dp
4320 
4321  f_a_inv=0.0_dp
4322  IF(lambda_a<tol) THEN
4323  CALL flagwarning("lambda_a is close to zero",err,error,*999)
4324 ! WRITE(*,*) "UP: ", UP
4325 ! WRITE(*,*) "LOW: ", LOW
4326 ! WRITE(*,*) "lambda_a: ", lambda_a
4327  lambda_a=lambda_a+tol
4328  ENDIF
4329  f_a_inv(1,1)=1.0_dp/lambda_a
4330  f_a_inv(2,2)=1.0_dp
4331  f_a_inv(3,3)=1.0_dp
4332 
4333  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
4334  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
4335  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
4336 
4337  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
4338  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4339  lwork=min(lwmax,int(work(1)))
4340  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
4341  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4342  evector_1=c_e(:,1)
4343  evector_2=c_e(:,2)
4344  evector_3=c_e(:,3)
4345 
4346  DO i=1,3
4347  DO j=1,3
4348  ematrix_1(i,j)=evector_1(i)*evector_1(j)
4349  ematrix_2(i,j)=evector_2(i)*evector_2(j)
4350  ematrix_3(i,j)=evector_3(i)*evector_3(j)
4351  END DO
4352  END DO
4353 
4354  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
4355  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
4356  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
4357  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
4358  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
4359  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
4360 
4361  free_energy=0.0_dp
4362  DO i=1,3
4363  free_energy=free_energy+c(i)/c(i+3)*( &
4364  & evalues(1)**(c(i+3)/2.0_dp)+ &
4365  & evalues(2)**(c(i+3)/2.0_dp)+ &
4366  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
4367  END DO
4368  free_energy=c(7)*free_energy
4369 
4370  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
4371 
4372  IF (VALUE.GE.0) THEN
4373  up=lambda_a
4374  ELSE
4375  low=lambda_a
4376  ENDIF
4377 
4378  ELSE
4379  !Newton's method -- needs to be checked TODO
4380 
4381  temp=dzdnu+dzdnut
4382  CALL matrix_product(f_e_t,temp,temp,err,error,*999)
4383  CALL matrix_product(temp,n1,temp1,err,error,*999)
4384  CALL matrix_product(temp,n2,temp2,err,error,*999)
4385  CALL matrix_product(temp,n3,temp3,err,error,*999)
4386 
4387  temp=0.0_dp
4388  DO i=1,3
4389  temp=temp+ &
4390  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*temp1+ &
4391  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*temp2+ &
4392  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*temp3
4393  END DO
4394  slope=temp(1,1)*c(7)
4395  lambda_a=lambda_a-VALUE/slope
4396  !IF (lambda_a.LE.0.0_DP) THEN
4397  ! lambda_a=0.1_DP
4398  !END IF
4399  !lambda_a=lambda_a-0.001
4400 
4401  f_a_inv=0.0_dp
4402  f_a_inv(1,1)=1.0_dp/lambda_a
4403  f_a_inv(2,2)=1.0_dp
4404  f_a_inv(3,3)=1.0_dp
4405 
4406  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
4407  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
4408  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
4409 
4410  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
4411  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4412  lwork=min(lwmax,int(work(1)))
4413  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
4414  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4415  evector_1=c_e(:,1)
4416  evector_2=c_e(:,2)
4417  evector_3=c_e(:,3)
4418 
4419  DO i=1,3
4420  DO j=1,3
4421  ematrix_1(i,j)=evector_1(i)*evector_1(j)
4422  ematrix_2(i,j)=evector_2(i)*evector_2(j)
4423  ematrix_3(i,j)=evector_3(i)*evector_3(j)
4424  END DO
4425  END DO
4426 
4427  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
4428  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
4429  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
4430  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
4431  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
4432  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
4433 
4434  free_energy=0.0_dp
4435  DO i=1,3
4436  free_energy=free_energy+c(i)/c(i+3)*( &
4437  & evalues(1)**(c(i+3)/2.0_dp)+ &
4438  & evalues(2)**(c(i+3)/2.0_dp)+ &
4439  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
4440  END DO
4441  free_energy=c(7)*free_energy
4442 
4443  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
4444  ENDIF
4445  ENDDO
4446 
4447  piola_tensor=0.0_dp
4448  DO i=1,3
4449  piola_tensor=piola_tensor+ &
4450  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*n1+ &
4451  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*n2+ &
4452  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*n3
4453  END DO
4454  piola_tensor=piola_tensor*c(7)+2.0_dp*p*azu
4455 
4456  !store lambda_f, so it can be used in the CellML file
4457  lambda_f=sqrt(azl(1,1))
4458  CALL field_parameter_set_update_gauss_point(dependent_field,field_u1_variable_type,field_values_set_type,gauss_point_number, &
4459  & element_number,1,lambda_f,err,error,*999)
4460 
4461 
4462  CASE(equations_set_1d3d_monodomain_active_strain_subtype)
4463 
4464  NULLIFY(independent_field)
4465  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
4466  NULLIFY(field_variable)
4467  CALL field_variable_get(independent_field,field_u_variable_type,field_variable,err,error,*999)
4468 
4469  dof_idx=field_variable%COMPONENTS(5)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4470  & element_number)
4471  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type,dof_idx,lambda_a, &
4472  & err,error,*999)
4473 
4474  f_a_inv=0.0_dp
4475  f_a_inv(1,1)=1.0_dp/lambda_a
4476  f_a_inv(2,2)=1.0_dp
4477  f_a_inv(3,3)=1.0_dp
4478 
4479  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
4480  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
4481  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
4482 
4483  !Odgen law - 3 terms. Material Parameters C = [mu(1) mu(2) mu(3) alpha(1) alpha(2) alpha(3) mu_0]
4484 ! CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
4485  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
4486  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4487  lwork=min(lwmax,int(work(1)))
4488  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
4489  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
4490  evector_1=c_e(:,1)
4491  evector_2=c_e(:,2)
4492  evector_3=c_e(:,3)
4493 
4494  DO i=1,3
4495  DO j=1,3
4496  ematrix_1(i,j)=evector_1(i)*evector_1(j)
4497  ematrix_2(i,j)=evector_2(i)*evector_2(j)
4498  ematrix_3(i,j)=evector_3(i)*evector_3(j)
4499  END DO
4500  END DO
4501 
4502  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
4503  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
4504  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
4505  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
4506  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
4507  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
4508 
4509  piola_tensor=0.0_dp
4510  DO i=1,3
4511  piola_tensor=piola_tensor+ &
4512  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*n1+ &
4513  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*n2+ &
4514  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*n3
4515  END DO
4516  piola_tensor=piola_tensor*c(7)+2.0_dp*p*azu
4517 
4518  CASE(equations_set_mooney_rivlin_subtype,equations_set_mooney_rivlin_activecontraction_subtype,equations_set_membrane_subtype, &
4519  & equations_set_no_subtype,equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
4520  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_standard_monodomain_elasticity_subtype, &
4521  & equations_set_1d3d_monodomain_elasticity_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
4522  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
4523  & equations_set_transverse_isotropic_active_subtype)
4524  !Form of constitutive model is:
4525  ! W=c1*(I1-3)+c2*(I2-3)+p*(I3-1)
4526  !Also assumed I3 = det(AZL) = 1.0
4527  ! Note that because PIOLA = 2.del{W}/del{C}=[...]+2.lambda.J^2.C^{-1}
4528  ! lambda here is actually half of hydrostatic pressure -- is this comment still correct?
4529  !If subtype is membrane, assume Mooney Rivlin constitutive law
4530  IF (equations_set_subtype/=equations_set_membrane_subtype) THEN
4531  piola_tensor(1,3)=2.0_dp*(c(2)*(-azl(3,1)))+p*azu(1,3)
4532  piola_tensor(2,3)=2.0_dp*(c(2)*(-azl(3,2)))+p*azu(2,3)
4533  piola_tensor(3,1)=piola_tensor(1,3)
4534  piola_tensor(3,2)=piola_tensor(2,3)
4535  piola_tensor(3,3)=2.0_dp*(c(1)+c(2)*(azl(1,1)+azl(2,2)))+p*azu(3,3)
4536  ELSE
4537  ! Membrane Equations
4538  ! Assume incompressible => I3 = 1 => C33(C11 x C22 - C12*C21) = 1
4539  azl(3,3) = 1.0_dp / ((azl(1,1) * azl(2,2)) - (azl(1,2) * azl(2,1)))
4540  ! Assume Mooney-Rivlin constitutive relation
4541  p = -1.0_dp*((c(1) + c(2) * (azl(1,1) + azl(2,2))) * azl(3,3))
4542  ! Assume stress normal to the surface is neglible i.e. PIOLA_TENSOR(:,3) = 0,PIOLA_TENSOR(3,:) = 0
4543  piola_tensor(:,3) = 0.0_dp
4544  piola_tensor(3,:) = 0.0_dp
4545  ENDIF
4546  piola_tensor(1,1)=2.0_dp*(c(1)+c(2)*(azl(2,2)+azl(3,3)))+p*azu(1,1)
4547  piola_tensor(1,2)=2.0_dp*( c(2)*(-azl(2,1)))+p*azu(1,2)
4548  piola_tensor(2,1)=piola_tensor(1,2)
4549  piola_tensor(2,2)=2.0_dp*(c(1)+c(2)*(azl(3,3)+azl(1,1)))+p*azu(2,2)
4550 
4551 
4552  SELECT CASE(equations_set_subtype)
4553  CASE(equations_set_mooney_rivlin_activecontraction_subtype)
4554  !add active contraction stress value to the trace of the stress tensor - basically adding to hydrostatic pressure.
4555  !the active stress is stored inside the independent field that has been set up in the user program.
4556  !for generality we could set up 3 components in independent field for 3 different active stress components
4557  !1 isotropic value assumed here.
4558  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4559  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,1,active_stress_11, &
4560  & err,error,*999) ! get the independent field stress value
4561 
4562  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4563  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,2,active_stress_22, &
4564  & err,error,*999) ! get the independent field stress value
4565 
4566  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4567  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,3,active_stress_33, &
4568  & err,error,*999) ! get the independent field stress value
4569 
4570  piola_tensor(1,1)=piola_tensor(1,1)+active_stress_11
4571  piola_tensor(2,2)=piola_tensor(2,2)+active_stress_22
4572  piola_tensor(3,3)=piola_tensor(3,3)+active_stress_33
4573 
4574  CASE(equations_set_standard_monodomain_elasticity_subtype)
4575  ! add the active stress component (stored in the independent field) to the 1,1-direction of the 2-PK tensor
4576  piola_tensor(1,1)=piola_tensor(1,1)+independent_interpolated_point%VALUES(1,no_part_deriv)
4577 
4578  CASE(equations_set_1d3d_monodomain_elasticity_subtype)
4579  !passive anisotropic stiffness -- only in the tension range
4580  IF(azl(1,1) > 1.0_dp) THEN
4581  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4582  ENDIF
4583  !active stress component
4584  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4585  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,1,VALUE, &
4586  & err,error,*999)
4587  !divide by lambda and multiply by P_max
4588  VALUE=VALUE/sqrt(azl(1,1))*c(5)
4589 
4590  !HINDAWI paper - force-length relation at the continuum level
4591 ! if((SQRT(AZL(1,1))>0.72_DP).AND.(SQRT(AZL(1,1))<1.68_DP)) then
4592 ! VALUE=VALUE*(-25.0_DP/4.0_DP*AZL(1,1)/1.2_DP/1.2_DP + 25.0_DP/2.0_DP*SQRT(AZL(1,1))/1.2_DP - 5.25_DP)
4593 ! else
4594 ! VALUE=0.0_DP
4595 ! endif
4596 
4597  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4598 
4599  CASE(equations_set_monodomain_elasticity_w_titin_subtype)
4600  !passive anisotropic stiffness -- only in the tension range
4601  IF(azl(1,1) > 1.0_dp) THEN
4602  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4603  ENDIF
4604  !active stress component
4605  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
4606  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4607  & element_number)
4608  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4609  & field_values_set_type,dof_idx,VALUE,err,error,*999)
4610 
4611  IF(VALUE.LT.0.0_dp) VALUE=0.0_dp
4612 
4613  !divide by lambda and multiply by P_max
4614  VALUE=VALUE/sqrt(azl(1,1))*c(5)
4615 
4616  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4617 
4618  ! unbound Titin-stress
4619  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4620  & element_number)
4621  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4622  & field_values_set_type,dof_idx,titin_unbound,err,error,*999)
4623  ! bound Titin-stress -> Rode Model
4624  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4625  & element_number)
4626  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4627  & field_values_set_type,dof_idx,titin_bound,err,error,*999)
4628  ! activation
4629  dof_idx=field_variable%COMPONENTS(6)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4630  & element_number)
4631  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4632  & field_values_set_type,dof_idx,activation,err,error,*999)
4633 
4634  IF(activation.GT.1.0_dp) activation=1.0_dp
4635  IF(activation.LT.0.0_dp) activation=0.0_dp
4636 
4637  ! parameter to switch on and off actin-titin interaction
4638  activation=c(6)*activation
4639 
4640  ! normalized Titin-stress -> weighted sum of bound and unbound titin-stress
4641  titin_value=activation*titin_bound+(1.0_dp-activation)*titin_unbound
4642  !TITIN_VALUE=activation*TITIN_BOUND*0.5_DP+(1.0_DP-activation)*TITIN_UNBOUND !TK Hack
4643  ! divide by lambda and multiply by P_max
4644  titin_value=titin_value/sqrt(azl(1,1))*c(5)
4645 
4646  piola_tensor(1,1)=piola_tensor(1,1)+titin_value
4647 
4648  ! unbound titin-stress in cross-fibre direction
4649  dof_idx=field_variable%COMPONENTS(4)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4650  & element_number)
4651  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4652  & field_values_set_type,dof_idx,titin_unbound_cross_fibre,err,error,*999)
4653  ! bound titin-stress in cross-fibre direction
4654  dof_idx=field_variable%COMPONENTS(5)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4655  & element_number)
4656  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4657  & field_values_set_type,dof_idx,titin_bound_cross_fibre,err,error,*999)
4658 
4659  ! normalized XF-Titin-stress -> weighted sum of bound and unbound XF-titin-stress
4660  titin_value_cross_fibre=activation*titin_bound_cross_fibre+(1.0_dp-activation)*titin_unbound_cross_fibre
4661  ! divide by lambda and multiply by P_max
4662  titin_value_cross_fibre=titin_value_cross_fibre*c(5) !/SQRT(AZL(1,1))
4663 
4664  piola_tensor(2,2)=piola_tensor(2,2)+titin_value_cross_fibre
4665  piola_tensor(3,3)=piola_tensor(3,3)+titin_value_cross_fibre
4666 
4667  CASE(equations_set_monodomain_elasticity_velocity_subtype)
4668  !passive anisotropic stiffness -- only in the tension range
4669  IF(azl(1,1) > 1.0_dp) THEN
4670 !tomo
4671 ! PIOLA_TENSOR(1,1)=PIOLA_TENSOR(1,1)+C(3)/AZL(1,1)*(AZL(1,1)**(C(4)/2.0_DP)-1.0_DP)
4672  piola_tensor(1,1)=piola_tensor(1,1)+0.355439810963035_dp/azl(1,1)*(azl(1,1)**(12.660539325481963_dp/2.0_dp)-1.0_dp)
4673  ENDIF
4674 !tomo
4675  IF(azl(2,2) > 1.0_dp) THEN
4676  piola_tensor(2,2)=piola_tensor(2,2)+5316.372204148964_dp/azl(2,2)*(azl(2,2)**(0.014991843974911_dp/2.0_dp)-1.0_dp)
4677  ENDIF
4678  IF(azl(3,3) > 1.0_dp) THEN
4679  piola_tensor(3,3)=piola_tensor(3,3)+5316.372204148964_dp/azl(3,3)*(azl(3,3)**(0.014991843974911_dp/2.0_dp)-1.0_dp)
4680  ENDIF
4681 !tomo end
4682  !active stress component
4683  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
4684  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_point_number, &
4685  & element_number)
4686  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
4687  & field_values_set_type,dof_idx,VALUE,err,error,*999)
4688  !divide by lambda and multiply by P_max
4689 !tomo RFE
4690  val1=VALUE
4691 !tomo REF end
4692  VALUE=VALUE/sqrt(azl(1,1))*c(5)
4693 
4694 
4695 !tomo RFE
4696  !alpha*K_rfe*(lambda-lambda_start)/lambda
4697  !TODO make lambda_start variable --> independent field
4698 ! VAL2=VAL1*100.0_DP*(SQRT(AZL(1,1))-1) !stretch and compression!!!
4699  val2=100.0_dp*(sqrt(azl(1,1))-1) !stretch and compression!!!
4700  VALUE=VALUE+val2/sqrt(azl(1,1))
4701  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4702 !tomo REF end
4703 
4704 ! PIOLA_TENSOR(1,1)=PIOLA_TENSOR(1,1)+VALUE
4705 
4706  CASE(equations_set_transverse_isotropic_polynomial_subtype)
4707  !Additional term for transversely isotropic (fibre-reinforced) materials (Markert, B., W. Ehlers, and N. Karajan.
4708  !A general polyconvex strain-energy function for fiber-reinforced materials.
4709  !Proceedings in Applied Mathematics and Mechanics 5.1 (2005): 245-246.)
4710 
4711  ! W_aniso=c3*(sqrt(I4)^(c4-2)-1/I4)M
4712  ! with M being the mapping towards the fibre direction, here: I4=C_11
4713  !C(3)=c3...polynomial coefficient
4714  !C(4)=c4...power coefficient
4715  IF(azl(1,1) > 1.0_dp) THEN ! only in the tension range
4716  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4717  ENDIF
4718 
4719  CASE(equations_set_transverse_isotropic_active_subtype)
4720  !Isotropic and anisotropic part from above, additionally an active part in fibre direction
4721  ! W=W_iso+W_aniso+W_act
4722  ! with W_act=(1/sqrt(I4)*P_max*f*alpha)M
4723  !C(5)=alpha...activation parameter [0,1]
4724  IF(azl(1,1) > 1.0_dp) THEN ! only in the tension range
4725  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4726  ENDIF
4727 ! IF((SQRT(AZL(1,1))>0.84_DP).AND.(SQRT(AZL(1,1))<1.96_DP)) THEN
4728  if((sqrt(azl(1,1))>0.72_dp).AND.(sqrt(azl(1,1))<1.68_dp)) then
4729 ! VALUE=(-25.0_DP/4.0_DP*AZL(1,1)/1.4_DP/1.4_DP + 25.0_DP/2.0_DP*SQRT(AZL(1,1))/1.4_DP - 5.25_DP) !f
4730  VALUE=(-25.0_dp/4.0_dp*azl(1,1)/1.2_dp/1.2_dp + 25.0_dp/2.0_dp*sqrt(azl(1,1))/1.2_dp - 5.25_dp)
4731  VALUE=VALUE*(1.0_dp/sqrt(azl(1,1)))*20.0_dp*c(5)
4732  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4733  ENDIF
4734 
4735  CASE(equations_set_anisotropic_polynomial_subtype)
4736  !Three additional terms for transversely isotropic (fibre-reinforced) materials (Markert, B., W. Ehlers, and N. Karajan.
4737  !A general polyconvex strain-energy function for fiber-reinforced materials.
4738  !Proceedings in Applied Mathematics and Mechanics 5.1 (2005): 245-246.)
4739  ! W_aniso=c3*(sqrt(I4)^(c4-2)-1/I4)M_1 + c5*(sqrt(I4)^(c6-2)-1/I4)M_2 + c7*(sqrt(I4)^(c8-2)-1/I4)M_3
4740  ! with M_1 being the mapping towards the fibre direction, here: I4=C_11
4741  !C(3)=c3...polynomial coefficient
4742  !C(4)=c4...power coefficient
4743  !C(5)=c5...polynomial coefficient
4744  !C(6)=c6...power coefficient
4745  !C(7)=c7...polynomial coefficient
4746  !C(8)=c8...power coefficient
4747  IF(azl(1,1) > 1.0_dp) THEN ! only in the tension range
4748  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4749  ENDIF
4750  IF(azl(2,2) > 1.0_dp) THEN
4751  piola_tensor(2,2)=piola_tensor(2,2)+c(5)/azl(2,2)*(azl(2,2)**(c(6)/2.0_dp)-1.0_dp)
4752  ENDIF
4753  IF(azl(3,3) > 1.0_dp) THEN
4754  piola_tensor(3,3)=piola_tensor(3,3)+c(7)/azl(3,3)*(azl(3,3)**(c(8)/2.0_dp)-1.0_dp)
4755  ENDIF
4756 
4757  CASE(equations_set_anisotropic_polynomial_active_subtype)
4758  !Three additional terms for transversely isotropic (fibre-reinforced) materials (Markert, B., W. Ehlers, and N. Karajan.
4759  !A general polyconvex strain-energy function for fiber-reinforced materials.
4760  !Proceedings in Applied Mathematics and Mechanics 5.1 (2005): 245-246.)
4761  ! W_aniso=c3*(sqrt(I4)^(c4-2)-1/I4)M_1 + c5*(sqrt(I4)^(c6-2)-1/I4)M_2 + c7*(sqrt(I4)^(c8-2)-1/I4)M_3
4762  ! with M_1 being the mapping towards the fibre direction, here: I4=C_11
4763  !C(3)=c3...polynomial coefficient
4764  !C(4)=c4...power coefficient
4765  !C(5)=c5...polynomial coefficient
4766  !C(6)=c6...power coefficient
4767  !C(7)=c7...polynomial coefficient
4768  !C(8)=c8...power coefficient
4769  !C(9)=lambda_opt...optimal fibre stretch
4770  !C(10)=P_max...maximum active tension
4771  !C(11)=alpha...activation parameter [0 1]
4772  !C(12)=K_rfe...stiffness of the residual force enhancement
4773  IF(azl(1,1) > 1.0_dp) THEN ! only in the tension range
4774  piola_tensor(1,1)=piola_tensor(1,1)+c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4775  ENDIF
4776  IF(azl(2,2) > 1.0_dp) THEN
4777  piola_tensor(2,2)=piola_tensor(2,2)+c(5)/azl(2,2)*(azl(2,2)**(c(6)/2.0_dp)-1.0_dp)
4778  ENDIF
4779  IF(azl(3,3) > 1.0_dp) THEN
4780  piola_tensor(3,3)=piola_tensor(3,3)+c(7)/azl(3,3)*(azl(3,3)**(c(8)/2.0_dp)-1.0_dp)
4781  ENDIF
4782 
4783  val1=sqrt(azl(1,1))/c(9) !lambda/lambda_opt
4784  IF((val1>0.7_dp).AND.(val1<1.3_dp)) THEN
4785  !active force-length relation
4786  VALUE=(-11.1111_dp*val1*val1+22.2222_dp*val1-10.1111_dp)
4787  !multiply by P_max and alpha, divide by lambda
4788  VALUE=VALUE*c(10)*c(11)/sqrt(azl(1,1))
4789  ELSE
4790  VALUE=0.0_dp
4791  ENDIF
4792  !alpha*K_rfe*(lambda-lambda_start)/lambda
4793  !TODO make lambda_start variable --> independent field
4794  val2=c(11)*c(12)*(sqrt(azl(1,1))-1) !stretch and compression!!!
4795  VALUE=VALUE+val2/sqrt(azl(1,1))
4796  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4797 
4798  END SELECT
4799 
4800 
4801  CASE(equations_set_trans_isotropic_active_transition_subtype)
4802  !Equations set for transversely isotropic (fibre-reinforced), active contractible bodies consitisting of two materials
4803  ! The local portion between them is defined by the parameter trans
4804  ! Material 1 is active contractible, material 2 is only passive
4805  !W=W_iso+W_aniso+W_act
4806  ! where the three parts are adopted from above (iso Mooney-Rivlin, aniso Markert, active part)
4807  !Markert, B., W. Ehlers, and N. Karajan.
4808  !A general polyconvex strain-energy function for fiber-reinforced materials.
4809  !Proceedings in Applied Mathematics and Mechanics 5.1 (2005): 245-246.)
4810 
4811  !C(1)=c1_m1...Mooney Rivlin parameter material 1
4812  !C(2)=c2_m1...Mooney Rivlin parameter material 1
4813  !C(3)=c4_m1...polynomial coefficient (Markert model) material 1
4814  !C(4)=c5_m1...power coefficient (Markert model) material 1
4815  !C(5)=c1_m2...Mooney Rivlin parameter material 2
4816  !C(6)=c2_m2...Mooney Rivlin parameter material 2
4817  !C(7)=c4_m2...polynomial coefficient (Markert model) material 2
4818  !C(8)=c5_m2...power coefficient (Markert model) material 2
4819  !C(9)=alpha...activation parameter [0,1]
4820  !C(10)=trans...transition parameter [0,1] for the portion between the two materials
4821  !C(11)=P_max...maximum isometric stress
4822 
4823  !Weighting the Mooney Rivlin parameters and obtaining resulting c1 and c2
4824  val1=c(1)*c(10)+c(5)*(1.0_dp-c(10))
4825  val2=c(2)*c(10)+c(6)*(1.0_dp-c(10))
4826 
4827  !Mooney-Rivlin for the isotropic part
4828  piola_tensor(1,1)=2.0_dp*(val1+val2*(azl(2,2)+azl(3,3))+p*azu(1,1))
4829  piola_tensor(1,2)=2.0_dp*( val2*(-azl(2,1)) +p*azu(1,2))
4830  piola_tensor(1,3)=2.0_dp*( val2*(-azl(3,1)) +p*azu(1,3))
4831  piola_tensor(2,1)=piola_tensor(1,2)
4832  piola_tensor(2,2)=2.0_dp*(val1+val2*(azl(3,3)+azl(1,1))+p*azu(2,2))
4833  piola_tensor(2,3)=2.0_dp*( val2*(-azl(3,2)) +p*azu(2,3))
4834  piola_tensor(3,1)=piola_tensor(1,3)
4835  piola_tensor(3,2)=piola_tensor(2,3)
4836  piola_tensor(3,3)=2.0_dp*(val1+val2*(azl(1,1)+azl(2,2))+p*azu(3,3))
4837 
4838  !passive anisotropic part -- only in the tension range (Markert)
4839  IF(azl(1,1) > 1.0_dp) THEN
4840  val1=c(3)/azl(1,1)*(azl(1,1)**(c(4)/2.0_dp)-1.0_dp)
4841  val2=c(7)/azl(1,1)*(azl(1,1)**(c(8)/2.0_dp)-1.0_dp)
4842  piola_tensor(1,1)=piola_tensor(1,1)+(val1*c(10)+val2*(1.0_dp-c(10)))
4843  ENDIF
4844 
4845  !active part
4846  IF((sqrt(azl(1,1))>0.84_dp).AND.(sqrt(azl(1,1))<1.96_dp)) THEN
4847  VALUE=(-25.0_dp/4.0_dp*azl(1,1)/1.4_dp/1.4_dp + 25.0_dp/2.0_dp*sqrt(azl(1,1))/1.4_dp - 5.25_dp)
4848  VALUE=VALUE*(1.0_dp/sqrt(azl(1,1)))*c(9)*c(10)*c(11)
4849  piola_tensor(1,1)=piola_tensor(1,1)+VALUE
4850  ENDIF
4851 
4852  CASE(equations_set_isotropic_exponential_subtype)
4853  !Form of constitutive model is:
4854  ! W=c1/2 (e^(c2*(I1-3)) - 1)
4855  ! S = 2*dW/dC + 2pC^-1
4856  piola_tensor=c(1)*c(2)*exp(c(2)*(azl(1,1)+azl(2,2)+azl(3,3)-3.0_dp))*identity+2.0_dp*p*azu
4857  CASE(equations_set_elasticity_fluid_pressure_static_inria_subtype)
4858  !C(1)=Mooney Rivlin parameter
4859  !C(2)=Mooney Rivlin parameter
4860  !C(3)=K
4861  !C(4)=M, Biot modulus
4862  !C(5)=b, skeleton parameter
4863  !C(6)=p0, reference pressure
4864 
4865  p=darcy_dependent_interpolated_point%VALUES(1,no_part_deriv) !Fluid pressure
4866  CALL matrix_transpose(azl,azlt,err,error,*999)
4867  i1=azl(1,1)+azl(2,2)+azl(3,3)
4868  temp=matmul(azl,azl)
4869  i2=0.5_dp*(i1**2.0_dp-temp(1,1)-temp(2,2)-temp(3,3))
4870 
4871  CALL evaluate_chapelle_function(jznu,ffact,dfdjfact,err,error,*999)
4872 
4873  piola_tensor=2.0_dp*c(1)*jznu**(-2.0_dp/3.0_dp)*(identity-(1.0_dp/3.0_dp)*i1*azu)
4874  piola_tensor=piola_tensor+2.0_dp*c(2)*jznu**(-4.0_dp/3.0_dp)*(i1*identity-azlt-(2.0_dp/3.0_dp)*i2*azu)
4875  piola_tensor=piola_tensor+(c(3)-c(4)*c(5)**2)*(jznu-1.0_dp)*azu
4876  piola_tensor=piola_tensor-c(5)*(p-c(6))*jznu*azu
4877  piola_tensor=piola_tensor+0.5_dp*((p-c(6))**2/c(4))*(dfdjfact/(ffact**2))*jznu*azu
4878  CASE(equations_set_elasticity_fluid_pressure_holmes_mow_subtype)
4879  ! See Holmes MH, Mow VC. The nonlinear characteristics of soft gels and hydrated connective tissues in ultrafiltration.
4880  ! Journal of Biomechanics. 1990;23(11):1145-1156. DOI: 10.1016/0021-9290(90)90007-P
4881  ! The form of constitutive relation is:
4882  ! sigma = sigma^s + sigma^f
4883  ! sigma^f = -phi^f p I
4884  ! sigma^s = -phi^s p I + rho_0^s sigma^s_E
4885  ! sigma^s_E is the effective Cauchy stress obtained by differentiating
4886  ! the free energy function to get the second Piola-Kirchoff stress tensor:
4887  ! rho_0^s W^s = c0 exp(c1(I1 - 3) + c2(I2 - 3)) / (I_3^(c1 + 2c2))
4888  ! Rather than add the "phi^s p I" term to the Cauchy stress, we add it here as "phi^s p J C^-1"
4889  ! We also set rho_0^s = the solid density * initial solidity, and move the solidity
4890  ! inside the strain energy density function
4891  !
4892  ! c0 = C(1)
4893  ! c1 = C(2)
4894  ! c2 = C(3)
4895  ! phi^s_0 = C(4)
4896 
4897  CALL matrix_transpose(azl,azlt,err,error,*999)
4898  CALL matrix_transpose(azu,azut,err,error,*999)
4899  i1=azl(1,1)+azl(2,2)+azl(3,3)
4900  temp=matmul(azl,azl)
4901  i2=0.5_dp*(i1**2.0_dp-temp(1,1)-temp(2,2)-temp(3,3))
4902  !I3 already defined
4903 
4904  tempterm=2.0_dp*c(4)*c(1)*exp(c(2)*(i1 - 3.0_dp) + c(3)*(i2 - 3.0_dp)) / (i3**(c(2)+2.0_dp*c(3)))
4905  piola_tensor=c(2)*tempterm*identity + c(3)*tempterm*(i1*identity-azlt) - (c(2)+2.0_dp*c(3))*tempterm*azut
4906  piola_tensor=piola_tensor - darcy_dependent_interpolated_point%VALUES(1,no_part_deriv)*jznu*azu
4907 
4908  CASE(equations_set_elasticity_fluid_pres_holmes_mow_active_subtype)
4909  ! See Holmes MH, Mow VC. The nonlinear characteristics of soft gels and hydrated connective tissues in ultrafiltration.
4910  ! Journal of Biomechanics. 1990;23(11):1145-1156. DOI: 10.1016/0021-9290(90)90007-P
4911  ! The form of constitutive relation is:
4912  ! sigma = sigma^s + sigma^f
4913  ! sigma^f = -phi^f p I
4914  ! sigma^s = -phi^s p I + rho_0^s sigma^s_E
4915  ! sigma^s_E is the effective Cauchy stress obtained by differentiating
4916  ! the free energy function to get the second Piola-Kirchoff stress tensor:
4917  ! rho_0^s W^s = c0 exp(c1(I1 - 3) + c2(I2 - 3)) / (I_3^(c1 + 2c2))
4918  ! Rather than add the "phi^s p I" term to the Cauchy stress, we add it here as "phi^s p J C^-1"
4919  ! We also set rho_0^s = the solid density * initial solidity, and move the solidity
4920  ! inside the strain energy density function
4921  !
4922  ! c0 = C(1)
4923  ! c1 = C(2)
4924  ! c2 = C(3)
4925  ! phi^s_0 = C(4)
4926  ! alpha = C(5) (activation level)
4927  ! P_max = C(6) (maximum isometric active stress)
4928 
4929  CALL matrix_transpose(azl,azlt,err,error,*999)
4930  CALL matrix_transpose(azu,azut,err,error,*999)
4931  i1=azl(1,1)+azl(2,2)+azl(3,3)
4932  temp=matmul(azl,azl)
4933  i2=0.5_dp*(i1**2.0_dp-temp(1,1)-temp(2,2)-temp(3,3))
4934  !I3 already defined
4935 
4936  tempterm=2.0_dp*c(4)*c(1)*exp(c(2)*(i1 - 3.0_dp) + c(3)*(i2 - 3.0_dp)) / (i3**(c(2)+2.0_dp*c(3)))
4937  piola_tensor=c(2)*tempterm*identity + c(3)*tempterm*(i1*identity-azlt) - (c(2)+2.0_dp*c(3))*tempterm*azut
4938  piola_tensor=piola_tensor - darcy_dependent_interpolated_point%VALUES(1,no_part_deriv)*jznu*azu
4939 
4940  IF((sqrt(azl(1,1))>0.72_dp).AND.(sqrt(azl(1,1))<1.68_dp)) THEN
4941  VALUE=(-25.0_dp/4.0_dp*azl(1,1)/1.2_dp/1.2_dp + 25.0_dp/2.0_dp*sqrt(azl(1,1))/1.2_dp - 5.25_dp)
4942  ELSE
4943  VALUE=0.0_dp
4944  END IF
4945 
4946  piola_tensor(1,1) = piola_tensor(1,1) + 1.0_dp/sqrt(azl(1,1))*c(5)*c(6)*VALUE
4947 
4948  CASE(equations_set_stvenant_kirchoff_activecontraction_subtype)
4949  ! For of constitutive model is:
4950  ! W = 0.5lambda*tr(E)^2 + mu*tr(E^2)
4951  ! S = dW/dE = lambda*tr(E)Identity + 2muE
4952  piola_tensor(1,3)=(2.0_dp*c(2)*e(1,3))+(2.0_dp*p*azu(1,3))
4953  piola_tensor(2,3)=(2.0_dp*c(2)*e(2,3))+(2.0_dp*p*azu(2,3))
4954  piola_tensor(3,1)=piola_tensor(1,3)
4955  piola_tensor(3,2)=piola_tensor(2,3)
4956  piola_tensor(3,3)=c(1)*(e(1,1)+e(2,2)+e(3,3))+(2.0_dp*e(3,3)*c(2)+(2.0_dp*p*azu(3,3)))
4957 
4958  piola_tensor(1,1)=c(1)*(e(1,1)+e(2,2)+e(3,3))+(2.0_dp*e(1,1)*c(2)+(2.0_dp*p*azu(1,1)))
4959  piola_tensor(1,2)=(2.0_dp*c(2)*e(1,2))+(2.0_dp*p*azu(1,2))
4960  piola_tensor(2,1)=piola_tensor(1,2)
4961  piola_tensor(2,2)=c(1)*(e(1,1)+e(2,2)+e(3,3))+(2.0_dp*e(2,2)*c(2)+(2.0_dp*p*azu(2,2)))
4962 
4963  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4964  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,1,active_stress_11, &
4965  & err,error,*999) ! get the independent field stress value
4966 
4967  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4968  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,2,active_stress_22, &
4969  & err,error,*999) ! get the independent field stress value
4970 
4971  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
4972  & field_u_variable_type, field_values_set_type,gauss_point_number,element_number,3,active_stress_33, &
4973  & err,error,*999) ! get the independent field stress value
4974 
4975  piola_tensor(1,1)=piola_tensor(1,1)+active_stress_11
4976  piola_tensor(2,2)=piola_tensor(2,2)+active_stress_22
4977  piola_tensor(3,3)=piola_tensor(3,3)+active_stress_33
4978 
4979  CASE(equations_set_transverse_isotropic_exponential_subtype)
4980  !Form of constitutive model is:
4981  ! W=c1/2 (e^Q - 1)
4982  ! where Q=2c2(E11+E22+E33)+c3(E11^2)+c4(E22^2+E33^2+E23^2+E32^2)+c5(E12^2+E21^2+E31^2+E13^2)
4983  ! with E expressed in fibre coordinates
4984 
4985  tempterm=c(1)*exp(2.0*c(2)*(e(1,1)+e(2,2)+e(3,3))+c(3)*e(1,1)**2+c(4)*(e(2,2)**2+e(3,3)**2+2.0_dp*e(2,3)**2)+ &
4986  & c(5)*2.0_dp*(e(1,2)**2+e(1,3)**2))
4987  piola_tensor(1,1)=(c(2)+c(3)*e(1,1))*tempterm+2.0_dp*p*azu(1,1)
4988  piola_tensor(1,2)=c(5)*e(1,2)*tempterm+2.0_dp*p*azu(1,2)
4989  piola_tensor(1,3)=c(5)*e(1,3)*tempterm+2.0_dp*p*azu(1,3)
4990  piola_tensor(2,1)=piola_tensor(1,2)
4991  piola_tensor(2,2)=(c(2)+c(4)*e(2,2))*tempterm+2.0_dp*p*azu(2,2)
4992  piola_tensor(2,3)=c(4)*e(2,3)*tempterm+2.0_dp*p*azu(2,3)
4993  piola_tensor(3,1)=piola_tensor(1,3)
4994  piola_tensor(3,2)=piola_tensor(2,3)
4995  piola_tensor(3,3)=(c(2)+c(4)*e(3,3))*tempterm+2.0_dp*p*azu(3,3)
4996 
4997  CASE(equations_set_transverse_isotropic_guccione_subtype,equations_set_guccione_activecontraction_subtype)
4998  ! W=C1*exp*(Q) + p(J-1)
4999  ! Q=C2*E(1,1)^2 + C3*(E(2,2)^2+E(3,3)^2+2*E(2,3)*E(3,2)) + 2*C4*(E(1,2)*E(2,1)+E(1,3)*E(3,1))
5000  q=c(2)*e(1,1)**2 + c(3)*(e(2,2)**2+e(3,3)**2+2.0_dp*e(2,3)**2) + 2.0_dp*c(4)*(e(1,2)**2+e(1,3)**2)
5001  tempterm=0.5_dp*c(1)*exp(q) ! iso term
5002  piola_tensor(1,1) = 2.0_dp*c(2) * e(1,1)
5003  piola_tensor(2,2) = 2.0_dp*c(3) * e(2,2)
5004  piola_tensor(3,3) = 2.0_dp*c(3) * e(3,3)
5005  piola_tensor(1,2) = 2.0_dp*c(4) * e(1,2)
5006  piola_tensor(2,1) = piola_tensor(1,2)
5007  piola_tensor(1,3) = 2.0_dp*c(4) * e(1,3)
5008  piola_tensor(3,1) = piola_tensor(1,3)
5009  piola_tensor(3,2) = 2.0_dp*c(3) * e(2,3)
5010  piola_tensor(2,3) = piola_tensor(3,2)
5011  piola_tensor = piola_tensor * tempterm
5012  ! pressure terms
5013 !
5014 ! TEMP DURING MERGE
5015 !
5016 ! PIOLA_TENSOR = PIOLA_TENSOR + 2.0_DP*p*Jznu*AZU ! is Jznu required here, or is it omitted everywhere else?
5017 !
5018 ! IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_GUCCIONE_ACTIVECONTRACTION_SUBTYPE) THEN
5019 ! !the active stress is stored inside the independent field that has been set up in the user program.
5020 ! !for better generality we could set up 3 components in independent field for 3 different active stress components,
5021 ! !but only one component is implemented so far for fibre active tension.
5022 ! CALL FIELD_VARIABLE_GET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VARIABLE,ERR,ERROR,*999)
5023 ! DO i=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS
5024 ! dof_idx=FIELD_VARIABLE%COMPONENTS(i)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
5025 ! & GAUSS_POINTS(GAUSS_POINT_NUMBER,ELEMENT_NUMBER)
5026 ! CALL FIELD_PARAMETER_SET_GET_LOCAL_DOF(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
5027 ! & FIELD_VALUES_SET_TYPE,dof_idx,VALUE,ERR,ERROR,*999)
5028 ! PIOLA_TENSOR(1,1)=PIOLA_TENSOR(1,1)+VALUE
5029 ! ENDDO
5030 ! ENDIF
5031  !PIOLA_TENSOR = PIOLA_TENSOR + 2.0_DP*p*Jznu*AZU ! is Jznu required here, or is it omitted everywhere else?
5032  piola_tensor = piola_tensor + p*azu ! is Jznu required here, or is it omitted everywhere else?
5033  IF(equations_set_subtype==equations_set_guccione_activecontraction_subtype) THEN
5034  !add active contraction stress value to the trace of the stress tensor - basically adding to hydrostatic pressure.
5035  !the active stress is stored inside the independent field that has been set up in the user program.
5036  !for generality we could set up 3 components in independent field for 3 different active stress components
5037  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
5038  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
5039  dof_idx=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
5040  & gauss_points(gauss_point_number,element_number)
5041  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
5042  & field_values_set_type,dof_idx,VALUE,err,error,*999)
5043  piola_tensor(component_idx,component_idx)=piola_tensor(component_idx,component_idx)+VALUE
5044  ENDDO
5045  ENDIF
5046  CASE(equations_set_transverse_isotropic_humphrey_yin_subtype)
5047  ! W=a*(exp(b(I1-3))-1) + c*(exp(d(alpha-1)^2)-1)
5048  ! a=C(1), b=C(2), c=C(3), d=C(4)
5049  i1=azl(1,1)+azl(2,2)+azl(3,3)
5050  piola_tensor(1,1)=c(1)*c(2)*exp(c(2)*(i1-3))+ &
5051  & c(3)*2.0_dp*(sqrt(azl(1,1))-1)*c(4)*exp(c(4)*(sqrt(azl(1,1))-1)**2)/(2*sqrt(azl(1,1)))+p*azu(1,1)
5052  piola_tensor(2,2)=c(1)*c(2)*exp(c(2)*(i1-3))+p*azu(2,2)
5053  piola_tensor(3,3)=c(1)*c(2)*exp(c(2)*(i1-3))+p*azu(3,3)
5054  piola_tensor(1,2)=p*azu(1,2)
5055  piola_tensor(1,3)=p*azu(1,3)
5056  piola_tensor(2,3)=p*azu(2,3)
5057  piola_tensor(2,1)=piola_tensor(1,2)
5058  piola_tensor(3,1)=piola_tensor(1,3)
5059  piola_tensor(3,2)=piola_tensor(2,3)
5060  piola_tensor=piola_tensor*2.0_dp
5061  CASE(equations_set_orthotropic_material_costa_subtype,equations_set_activecontraction_subtype) !added by Robert 2010-01-23
5062  !Form of constitutive model is:
5063  ! W=a/2 (e^Q - 1)
5064  ! where Q=[b_ff 2b_fs 2b_fn b_ss 2b_sn b_nn]'* [E_ff E_fs E_fn E_ss E_sn E_nn].^2;
5065  ! f,s,n denotes the fibre sheet and sheet-normal direction
5066  a = materials_interpolated_point%VALUES(1,1)
5067  b(1,1) = materials_interpolated_point%VALUES(1+1,1)
5068  b(1,2) = materials_interpolated_point%VALUES(1+2,1)
5069  b(1,3) = materials_interpolated_point%VALUES(1+3,1)
5070  b(2,1) = b(1,2);
5071  b(2,2) = materials_interpolated_point%VALUES(1+4,1)
5072  b(2,3) = materials_interpolated_point%VALUES(1+5,1)
5073  b(3,1) = b(1,3);
5074  b(3,2) = b(2,3);
5075  b(3,3) = materials_interpolated_point%VALUES(1+6,1)
5076  q = 0.0_dp;
5077  DO i=1,3,1
5078  DO j=1,3,1
5079  IF (i==j) THEN
5080  e(i,j) = 0.5_dp * (azl(i,j)-1);
5081  ELSE
5082  e(i,j) = 0.5_dp * azl(i,j);
5083  ENDIF
5084  q = q + b(i,j) * e(i,j) * e(i,j)
5085  ENDDO
5086  ENDDO
5087  q = exp(q);
5088  DO i=1,3,1
5089  DO j=1,3,1
5090  piola_tensor(i,j)=a*b(i,j)*e(i,j)*q + p*azu(i,j);
5091  ENDDO
5092  ENDDO
5093 
5094  IF(equations_set_subtype == equations_set_activecontraction_subtype) THEN
5095  CALL finiteelasticity_piolaaddactivecontraction(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
5096  & equations_set%EQUATIONS%INTERPOLATION%MATERIALS_FIELD, piola_tensor(1,1),e(1,1), &
5097  & element_number,gauss_point_number,err,error,*999)
5098  ENDIF
5099  CASE (equations_set_compressible_finite_elasticity_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
5100  & equations_set_compressible_activecontraction_subtype, &
5101  & equations_set_incompressible_elasticity_driven_darcy_subtype,equations_set_incompressible_elast_multi_comp_darcy_subtype)
5102  !Form of constitutive model is:
5103  ! W=c1*(I1-3)+c2*(I2-3)+c3*(J-1)^2 (this is actually nearly incompressible)
5104  c(1)=materials_interpolated_point%VALUES(1,1)
5105  c(2)=materials_interpolated_point%VALUES(2,1)
5106 
5107  piola_tensor(1,1)=c(1)+c(2)*(azl(2,2)+azl(3,3))
5108  piola_tensor(1,2)=c(2)*(-azl(2,1))
5109  piola_tensor(1,3)=c(2)*(-azl(3,1))
5110  piola_tensor(2,1)=piola_tensor(1,2)
5111  piola_tensor(2,2)=c(1)+c(2)*(azl(3,3)+azl(1,1))
5112  piola_tensor(2,3)=c(2)*(-azl(3,2))
5113  piola_tensor(3,1)=piola_tensor(1,3)
5114  piola_tensor(3,2)=piola_tensor(2,3)
5115  piola_tensor(3,3)=c(1)+c(2)*(azl(1,1)+azl(2,2))
5116  piola_tensor=piola_tensor*2.0_dp
5117 
5118  IF(diagnostics1) THEN
5119  CALL write_string_value(diagnostic_output_type," C(1) = ",c(1),err,error,*999)
5120  CALL write_string_value(diagnostic_output_type," C(2) = ",c(2),err,error,*999)
5121  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
5122  & 3,3,azl,write_string_matrix_name_and_indices,'(" AZL','(",I1,",:)',' :",3(X,E13.6))', &
5123  & '(17X,3(X,E13.6))',err,error,*999)
5124  ENDIF
5125 
5126  IF(equations_set_subtype==equations_set_compressible_activecontraction_subtype) THEN
5127 
5128  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
5129  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,1,active_stress_11, &
5130  & err,error,*999) ! get the independent field stress value
5131 
5132  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
5133  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,2,active_stress_22, &
5134  & err,error,*999) ! get the independent field stress value
5135 
5136  CALL field_parametersetgetlocalgausspoint(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
5137  & field_u_variable_type,field_values_set_type,gauss_point_number,element_number,3,active_stress_33, &
5138  & err,error,*999) ! get the independent field stress value
5139 
5140  piola_tensor(1,1)=piola_tensor(1,1)+active_stress_11
5141  piola_tensor(2,2)=piola_tensor(2,2)+active_stress_22
5142  piola_tensor(3,3)=piola_tensor(3,3)+active_stress_33
5143  ENDIF
5144  IF(equations_set_subtype==equations_set_compressible_finite_elasticity_subtype .OR. &
5145  & equations_set_subtype==equations_set_compressible_activecontraction_subtype) THEN
5146  c(3)=materials_interpolated_point%VALUES(3,1)
5147  piola_tensor=piola_tensor+2.0_dp*c(3)*(i3-sqrt(i3))*azu
5148  ELSEIF(equations_set_subtype==equations_set_elasticity_darcy_inria_model_subtype.OR. &
5149  & equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype .OR. &
5150  & equations_set_subtype==equations_set_incompressible_elast_multi_comp_darcy_subtype) THEN
5151  SELECT CASE (equations_set_subtype)
5152  CASE (equations_set_elasticity_darcy_inria_model_subtype) !Nearly incompressible
5153  c(3)=materials_interpolated_point%VALUES(3,1)
5154  !Starting point for this models is above compressible form of 2nd PK tensor
5155  !Adjust for the modified Ciarlet-Geymonat expression: Eq.(22) of the INRIA paper
5156  ! Question is: What deviation is to be penalized : (J-1) or (J-1-m/rho) ??? Probably the latter !
5157  ! However, m/rho is a given 'constant' and, upon differentiation, drops out.
5158  ! But it is important to retain I3 = J^2, since J ~ 1 + m/rho /= 1
5159  piola_tensor=piola_tensor+c(3)*(sqrt(i3)-1.0_dp)*azu
5160  darcy_mass_increase_entry = 5 !fifth entry
5161  CASE (equations_set_incompressible_elasticity_driven_darcy_subtype, &
5162  & equations_set_incompressible_elast_multi_comp_darcy_subtype) !Incompressible
5163  !Constitutive model: W=c1*(I1-3)+c2*(I2-3)+p*(I3-1)
5164  ! The term 'p*(I3-1)' gives rise to: '2p I3 AZU'
5165  ! Retain I3 = J^2, since J ~ 1 + m/rho /= 1
5166 ! CASE (EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_MR_SUBTYPE)
5167  !Constitutive model: W=C1*(J1-3)+C2*(J2-3)+C3*(J-1)^2+lambda.(J-1-m/rho)
5168  !J1 and J2 are the modified invariants, adjusted for volume change (J1=I1*J^(-2/3), J2=I2*J^(-4/3))
5169  !Strictly speaking this law isn't for an incompressible material, but the fourth equation in the elasticity
5170  !is used to satisfy a subtly different constraint, which is to require the solid portion of the poroelastic
5171  !material retains its volume. (This law is applied on the whole pororous body).
5172 
5173  piola_tensor=0.0_dp
5174  temp=0.0_dp
5175 
5176  c(1)=materials_interpolated_point%VALUES(1,1)
5177  c(2)=materials_interpolated_point%VALUES(2,1)
5178  c(3)=materials_interpolated_point%VALUES(3,1)
5179 
5180  !J1 term: del(J1)/del(C)=J^(-2/3)*I-2/3*I_1*J^(-2/3)*C^-1
5181  tempterm=jznu**(-2.0_dp/3.0_dp)
5182  temp(1,1)=tempterm
5183  temp(2,2)=tempterm
5184  temp(3,3)=tempterm
5185  i1=azl(1,1)+azl(2,2)+azl(3,3)
5186  piola_tensor=c(1)* (temp-1.0_dp/3.0_dp*i1*tempterm*azu)
5187 
5188  !J2 term: del(J2)/del(C)=J^(-4/3)*del(I2)/del(C) -4/3*I_2*J^(-4/3)*C^-1
5189  temp=matmul(azl,azl) ! C^2
5190  i2=0.5_dp*(i1**2.0_dp-(temp(1,1)+temp(2,2)+temp(3,3)))
5191  tempterm=jznu**(-4.0_dp/3.0_dp)
5192  !TEMP is now del(I2)/del(C)
5193  temp(1,1)=azl(2,2)+azl(3,3)
5194 ! TEMP(1,2)=-2.0_DP*AZL(1,2)
5195  temp(1,2)=-1.0_dp*azl(1,2)
5196 ! TEMP(1,3)=-2.0_DP*AZL(1,3)
5197  temp(1,3)=-1.0_dp*azl(1,3)
5198  temp(2,1)=temp(1,2)
5199  temp(2,2)=azl(1,1)+azl(3,3)
5200 ! TEMP(2,3)=-2.0_DP*AZL(2,3)
5201  temp(2,3)=-1.0_dp*azl(2,3)
5202  temp(3,1)=temp(1,3)
5203  temp(3,2)=temp(2,3)
5204  temp(3,3)=azl(1,1)+azl(2,2)
5205  piola_tensor=piola_tensor+c(2)* (tempterm*temp-2.0_dp/3.0_dp*i2*tempterm*azu)
5206 
5207  !J (det(F)) term: (2.C3.(J-1)+lambda)*J.C^-1
5208  piola_tensor=piola_tensor+(2.0_dp*c(3)*(jznu-1.0_dp)+p)*jznu*azu
5209 
5210  !Don't forget, it's wrt C so there is a factor of 2 - but not for the pressure !!??
5211  piola_tensor=2.0_dp*piola_tensor
5212 
5213 
5214  darcy_mass_increase_entry = 4 !fourth entry
5215 
5216  END SELECT
5217 
5218 ! DARCY_MASS_INCREASE = DARCY_DEPENDENT_INTERPOLATED_POINT%VALUES(DARCY_MASS_INCREASE_ENTRY,NO_PART_DERIV)
5219 !
5220 ! CALL EVALUATE_CHAPELLE_PIOLA_TENSOR_ADDITION(AZL,AZU,DARCY_MASS_INCREASE,PIOLA_TENSOR_ADDITION,ERR,ERROR,*999)
5221 !
5222 ! IF(DIAGNOSTICS1) THEN
5223 ! CALL WRITE_STRING_MATRIX(DIAGNOSTIC_OUTPUT_TYPE,1,1,3,1,1,3, &
5224 ! & 3,3,PIOLA_TENSOR,WRITE_STRING_MATRIX_NAME_AND_INDICES,'(" PIOLA_TENSOR','(",I1,",:)',' :",3(X,E13.6))', &
5225 ! & '(17X,3(X,E13.6))',ERR,ERROR,*999)
5226 ! CALL WRITE_STRING_MATRIX(DIAGNOSTIC_OUTPUT_TYPE,1,1,3,1,1,3, &
5227 ! & 3,3,PIOLA_TENSOR_ADDITION, &
5228 ! & WRITE_STRING_MATRIX_NAME_AND_INDICES,'(" PIOLA_TENSOR_ADDITION','(",I1,",:)',' :",3(X,E13.6))', &
5229 ! & '(17X,3(X,E13.6))',ERR,ERROR,*999)
5230 ! ENDIF
5231 !
5232 ! PIOLA_TENSOR = PIOLA_TENSOR + PIOLA_TENSOR_ADDITION
5233  ENDIF
5234 
5235  CASE (equations_set_orthotropic_material_holzapfel_ogden_subtype, &
5236  & equations_set_holzapfel_ogden_activecontraction_subtype)
5237  !Form of the constitutive model is:
5238  ! W = a/(2*b)*exp[b*(I1-3)] + sum_(i=f,s)[H(I4i-1)*a_i/(2*b_i)*(exp[b_i*(I4i-1)^2]-1)] + a_fs/(2*b_fs)*(exp[b_fs*I8fs^2]-1)
5239  !where H is the Heaviside step function. Fibres only contribute stiffness if in tension.
5240  !Also assumed I3 = det(AZL) = J^2 = 1.0 - incompressible material
5241  !Assume directions: fibre f_0=[1 0 0], sheet s_0=[0 1 0], (sheet) normal n_0=[0 0 1]
5242  !Based on: Holzapfel, G. A., & Ogden, R. W. (2009). Constitutive modelling of passive myocardium: A structurally based
5243  ! framework for material characterization. Philosophical Transactions of the Royal Society A: Mathematical, Physical and
5244  ! Engineering Sciences, 367(1902), 3445-3475. doi:10.1098/rsta.2009.0091
5245  c(1)=materials_interpolated_point%VALUES(1,1) !a
5246  c(2)=materials_interpolated_point%VALUES(2,1) !b
5247  c(3)=materials_interpolated_point%VALUES(3,1) !a_f
5248  c(4)=materials_interpolated_point%VALUES(4,1) !a_s
5249  c(5)=materials_interpolated_point%VALUES(5,1) !b_f
5250  c(6)=materials_interpolated_point%VALUES(6,1) !b_s
5251  c(7)=materials_interpolated_point%VALUES(7,1) !a_fs
5252  c(8)=materials_interpolated_point%VALUES(8,1) !b_fs
5253  i1=azl(1,1)+azl(2,2)+azl(3,3)
5254  tempterm=c(1)*exp(c(2)*(i1-3.0_dp))
5255  piola_tensor(1,1)=-p*azu(1,1)+tempterm
5256  IF(azl(1,1)>1.0_dp) THEN
5257  piola_tensor(1,1)=piola_tensor(1,1)+2.0_dp*c(3)*(azl(1,1)-1.0_dp)*exp(c(5)*(azl(1,1)-1.0_dp)**2.0_dp)
5258  END IF
5259  piola_tensor(1,2)=-p*azu(1,2)+c(7)*azl(1,2)*exp(c(8)*azl(1,2)**2.0_dp)
5260  piola_tensor(1,3)=-p*azu(1,3)
5261  piola_tensor(2,1)=piola_tensor(1,2)
5262  piola_tensor(2,2)=-p*azu(2,2)+tempterm
5263  IF(azl(2,2)>1.0_dp) THEN
5264  piola_tensor(2,2)=piola_tensor(2,2)+2.0_dp*c(4)*(azl(2,2)-1.0_dp)*exp(c(6)*(azl(2,2)-1.0_dp)**2.0_dp)
5265  END IF
5266  piola_tensor(2,3)=-p*azu(2,3)
5267  piola_tensor(3,1)=piola_tensor(1,3)
5268  piola_tensor(3,2)=piola_tensor(2,3)
5269  piola_tensor(3,3)=-p*azu(3,3)+tempterm
5270 
5271  IF(equations_set_subtype==equations_set_holzapfel_ogden_activecontraction_subtype) THEN
5272  !add active contraction stress value to the trace of the stress tensor - basically adding to hydrostatic pressure.
5273  !the active stress is stored inside the independent field that has been set up in the user program.
5274  !for generality we could set up 3 components in independent field for 3 different active stress components
5275  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
5276  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
5277  dof_idx=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
5278  & gauss_points(gauss_point_number,element_number)
5279  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
5280  & field_values_set_type,dof_idx,VALUE,err,error,*999)
5281  piola_tensor(component_idx,component_idx)=piola_tensor(component_idx,component_idx)+VALUE
5282  ENDDO
5283  ENDIF
5284 
5285  CASE DEFAULT
5286  local_error="The third equations set specification of "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
5287  & " is not valid for a finite elasticity type of an elasticity equation set."
5288  CALL flagerror(local_error,err,error,*999)
5289  END SELECT
5290 
5291  CALL matrix_product(dzdnu,piola_tensor,temp,err,error,*999)
5292  CALL matrix_product(temp,dzdnut,cauchy_tensor,err,error,*999)
5293 
5294  cauchy_tensor=cauchy_tensor/jznu
5295  IF(diagnostics1) THEN
5296  CALL write_string_value(diagnostic_output_type," ELEMENT_NUMBER = ",element_number,err,error,*999)
5297  CALL write_string_value(diagnostic_output_type," gauss_idx = ",gauss_point_number,err,error,*999)
5298  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
5299  & 3,3,piola_tensor,write_string_matrix_name_and_indices,'(" PIOLA_TENSOR','(",I1,",:)',' :",3(X,E13.6))', &
5300  & '(17X,3(X,E13.6))',err,error,*999)
5301  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
5302  & 3,3,cauchy_tensor,write_string_matrix_name_and_indices,'(" CAUCHY_TENSOR','(",I1,",:)',' :",3(X,E13.6))', &
5303  & '(17X,3(X,E13.6))',err,error,*999)
5304  ENDIF
5305  NULLIFY(c)
5306 
5307  exits("FINITE_ELASTICITY_GAUSS_CAUCHY_TENSOR")
5308  RETURN
5309 999 errorsexits("FINITE_ELASTICITY_GAUSS_CAUCHY_TENSOR",err,error)
5310  RETURN 1
5311  END SUBROUTINE finite_elasticity_gauss_cauchy_tensor
5312 
5313  !
5314  !================================================================================================================================
5315  !
5316 
5318  SUBROUTINE finiteelasticity_gaussgrowthtensor_newer123(equationsSet,numberOfDimensions,gaussPointNumber,elementNumber, &
5319  & dependentfield, deformationgradienttensor,growthtensor,elasticdeformationgradienttensor,jg,je,err,error,*)
5320 
5321  !Argument variables
5322  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
5323  INTEGER(INTG), INTENT(IN) :: numberOfDimensions
5324  INTEGER(INTG), INTENT(IN) :: gaussPointNumber
5325  INTEGER(INTG), INTENT(IN) :: elementNumber
5326  TYPE(field_type), POINTER :: dependentField
5327  REAL(DP), INTENT(IN) :: deformationGradientTensor(3,3)
5328  REAL(DP), INTENT(OUT) :: growthTensor(3,3)
5329  REAL(DP), INTENT(OUT) :: elasticDeformationGradientTensor(3,3)
5330  REAL(DP), INTENT(OUT) :: Jg
5331  REAL(DP), INTENT(OUT) :: Je
5332  INTEGER(INTG), INTENT(OUT) :: err
5333  TYPE(varying_string), INTENT(OUT) :: error
5334  !Local Variables
5335  REAL(DP) :: growthTensorInverse(3,3), growthTensorInverseTranspose(3,3)
5336 
5337  enters("FiniteElasticity_GaussGrowthTensor",err,error,*999)
5338 
5339  IF(ASSOCIATED(equationsset)) THEN
5340  CALL identitymatrix(growthtensor,err,error,*999)
5341  IF(equationsset%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
5342  CALL field_parametersetgetlocalgausspoint(dependentfield,field_u3_variable_type,field_values_set_type, &
5343  & gausspointnumber,elementnumber,1,growthtensor(1,1),err,error,*999)
5344  IF(numberofdimensions>1) THEN
5345  CALL field_parametersetgetlocalgausspoint(dependentfield,field_u3_variable_type,field_values_set_type, &
5346  & gausspointnumber,elementnumber,2,growthtensor(2,2),err,error,*999)
5347  IF(numberofdimensions>2) THEN
5348  CALL field_parametersetgetlocalgausspoint(dependentfield,field_u3_variable_type,field_values_set_type, &
5349  & gausspointnumber,elementnumber,3,growthtensor(3,3),err,error,*999)
5350  ENDIF
5351  ENDIF
5352  !Calculate inverse growth deformation tensor, Fg^-1, Jg
5353  CALL invert(growthtensor,growthtensorinverse,jg,err,error,*999)
5354  !Calculate elastic deformation tensor, Fe=F.(Fg)^-1.
5355  CALL matrixproduct(deformationgradienttensor,growthtensorinverse,elasticdeformationgradienttensor,err,error,*999)
5356  ELSE
5357  jg=1.0_dp
5358  elasticdeformationgradienttensor=deformationgradienttensor
5359  ENDIF
5360  je=determinant(elasticdeformationgradienttensor,err,error)
5361  IF(err/=0) GOTO 999
5362  ELSE
5363  CALL flagerror("Equations set is not associated.",err,error,*999)
5364  ENDIF
5365 
5366  IF(diagnostics1) THEN
5367  CALL writestring(diagnostic_output_type,"",err,error,*999)
5368  CALL writestring(diagnostic_output_type,"Growth information:",err,error,*999)
5369  CALL writestring(diagnostic_output_type," Total deformation gradient tensor:",err,error,*999)
5370  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,deformationgradienttensor, &
5371  & write_string_matrix_name_and_indices,'(" F','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
5372  CALL writestringvalue(diagnostic_output_type," Determinant F, J = ",determinant(deformationgradienttensor,err,error), &
5373  & err,error,*999)
5374  CALL writestring(diagnostic_output_type," Elastic component of the deformation gradient tensor:",err,error,*999)
5375  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,elasticdeformationgradienttensor, &
5376  & write_string_matrix_name_and_indices,'(" Fe','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
5377  CALL writestringvalue(diagnostic_output_type," Determinant Fe, Je = ",je,err,error,*999)
5378  CALL writestring(diagnostic_output_type," Growth component of the deformation gradient tensor:",err,error,*999)
5379  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3,3,3,growthtensor, &
5380  & write_string_matrix_name_and_indices,'(" Fg','(",I1,",:)',' :",3(X,E13.6))','(13X,3(X,E13.6))',err,error,*999)
5381  CALL writestringvalue(diagnostic_output_type," Determinant Fg, Jg = ",jg,err,error,*999)
5382  ENDIF
5383 
5384  exits("FiniteElasticity_GaussGrowthTensor")
5385  RETURN
5386  999 errorsexits("FiniteElasticity_GaussGrowthTensor",err,error)
5387  RETURN 1
5388 
5389  END SUBROUTINE finiteelasticity_gaussgrowthtensor_newer123
5390 
5391  !
5392  !================================================================================================================================
5393  !
5394 
5396  SUBROUTINE finiteelasticity_straintensor_newer123(deformationGradientTensor,rightCauchyDeformationTensor,&
5397  & fingerdeformationtensor, jacobian,greenstraintensor,err,error,*)
5398 
5399  !Argument variables
5400  REAL(DP), INTENT(IN) :: deformationGradientTensor(3,3)
5401  REAL(DP), INTENT(OUT) :: rightCauchyDeformationTensor(3,3)
5402  REAL(DP), INTENT(OUT) :: fingerDeformationTensor(3,3)
5403  REAL(DP), INTENT(OUT) :: Jacobian
5404  REAL(DP), INTENT(OUT) :: greenStrainTensor(3,3)
5405  INTEGER(INTG), INTENT(OUT) :: err
5406  TYPE(varying_string), INTENT(OUT) :: error
5407  !Local Variables
5408  INTEGER(INTG) :: i
5409  REAL(DP) :: I3
5410 
5411  enters("FiniteElasticity_StrainTensor",err,error,*999)
5412 
5413  CALL matrixtransposeproduct(deformationgradienttensor,deformationgradienttensor,rightcauchydeformationtensor,err,error,*999)
5414  CALL invert(rightcauchydeformationtensor,fingerdeformationtensor,i3,err,error,*999)
5415  jacobian=determinant(deformationgradienttensor,err,error)
5416 
5417  greenstraintensor=0.5_dp*rightcauchydeformationtensor
5418  DO i=1,3
5419  greenstraintensor(i,i)=greenstraintensor(i,i)-0.5_dp
5420  ENDDO !i
5421 
5422  IF(diagnostics1) THEN
5423  CALL writestring(diagnostic_output_type,"",err,error,*999)
5424  CALL writestring(diagnostic_output_type,"Strain information:",err,error,*999)
5425  CALL writestring(diagnostic_output_type," Right Cauchy-Green deformation tensor:",err,error,*999)
5426  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
5427  & 3,3,rightcauchydeformationtensor,write_string_matrix_name_and_indices, '(" C','(",I1,",:)', &
5428  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
5429  CALL writestring(diagnostic_output_type," Finger deformation tensor:",err,error,*999)
5430  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
5431  & 3,3,fingerdeformationtensor,write_string_matrix_name_and_indices, '(" f','(",I1,",:)', &
5432  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
5433  CALL writestringvalue(diagnostic_output_type," Jacobian = ",jacobian,err,error,*999)
5434  CALL writestring(diagnostic_output_type," Green-Lagrange strain tensor:",err,error,*999)
5435  CALL writestringmatrix(diagnostic_output_type,1,1,3,1,1,3, &
5436  & 3,3,greenstraintensor,write_string_matrix_name_and_indices, '(" E','(",I1,",:)', &
5437  & ' :",3(X,E13.6))','(12X,3(X,E13.6))',err,error,*999)
5438  ENDIF
5439 
5440  exits("FiniteElasticity_StrainTensor")
5441  RETURN
5442  999 errorsexits("FiniteElasticity_StrainTensor",err,error)
5443  RETURN 1
5444 
5445  END SUBROUTINE finiteelasticity_straintensor_newer123
5446 
5447  !
5448  !================================================================================================================================
5449  !
5450 
5452  SUBROUTINE finite_elasticity_gauss_stress_tensor(EQUATIONS_SET,DEPENDENT_INTERPOLATED_POINT, &
5453  & materials_interpolated_point,stress_tensor,dzdnu,jznu,element_number,gauss_point_number,err,error,*)
5454 
5455  !Argument variables
5456  TYPE(equations_set_type), POINTER, INTENT(IN) :: EQUATIONS_SET
5457  TYPE(field_interpolated_point_type), POINTER :: DEPENDENT_INTERPOLATED_POINT,MATERIALS_INTERPOLATED_POINT
5458  REAL(DP), INTENT(OUT) :: STRESS_TENSOR(:)
5459  REAL(DP), INTENT(IN) :: DZDNU(3,3) !Deformation gradient tensor at the gauss point
5460  REAL(DP), INTENT(IN) :: Jznu !Determinant of deformation gradient tensor (AZL)
5461  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER,GAUSS_POINT_NUMBER
5462  INTEGER(INTG), INTENT(OUT) :: ERR
5463  TYPE(varying_string), INTENT(OUT) :: ERROR
5464  !Local Variables
5465  INTEGER(INTG) :: PRESSURE_COMPONENT,component_idx,dof_idx
5466  REAL(DP) :: P
5467  REAL(DP) :: I1 !Invariants, if needed
5468  REAL(DP) :: TEMPTERM1,TEMPTERM2,VALUE !Temporary variables
5469  REAL(DP) :: ONETHIRD_TRACE
5470  TYPE(varying_string) :: LOCAL_ERROR
5471  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
5472  REAL(DP) :: MOD_DZDNU(3,3),MOD_DZDNUT(3,3),AZL(3,3)
5473  REAL(DP) :: B(6),E(6),DQ_DE(6)
5474  REAL(DP), POINTER :: C(:) !Parameters for constitutive laws
5475 
5476  enters("FINITE_ELASTICITY_GAUSS_STRESS_TENSOR",err,error,*999)
5477 
5478  NULLIFY(field_variable,c)
5479 
5480  !AZL = F'*F (deformed covariant or right cauchy deformation tensor, C)
5481  !AZU - deformed contravariant tensor; I3 = det(C)
5482 
5483  mod_dzdnu=dzdnu*jznu**(-1.0_dp/3.0_dp)
5484  CALL matrix_transpose(mod_dzdnu,mod_dzdnut,err,error,*999)
5485  CALL matrix_product(mod_dzdnut,mod_dzdnu,azl,err,error,*999)
5486  c=>materials_interpolated_point%VALUES(:,no_part_deriv)
5487 
5488  SELECT CASE(equations_set%specification(3))
5489  CASE(equations_set_mooney_rivlin_activecontraction_subtype,equations_set_mooney_rivlin_subtype)
5490  pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE%NUMBER_OF_COMPONENTS
5491  p=dependent_interpolated_point%VALUES(pressure_component,no_part_deriv)
5492  !Form of constitutive model is:
5493  !W=c1*(I1-3)+c2*(I2-3)+p/2*(I3-1)
5494 
5495  !Calculate isochoric fictitious 2nd Piola tensor (in Voigt form)
5496  i1=azl(1,1)+azl(2,2)+azl(3,3)
5497  tempterm1=-2.0_dp*c(2)
5498  tempterm2=2.0_dp*(c(1)+i1*c(2))
5499  stress_tensor(1)=tempterm1*azl(1,1)+tempterm2
5500  stress_tensor(2)=tempterm1*azl(2,2)+tempterm2
5501  stress_tensor(3)=tempterm1*azl(3,3)+tempterm2
5502  stress_tensor(4)=tempterm1*azl(2,1)
5503  stress_tensor(5)=tempterm1*azl(3,1)
5504  stress_tensor(6)=tempterm1*azl(3,2)
5505 
5506  IF(equations_set%specification(3)==equations_set_mooney_rivlin_activecontraction_subtype) THEN
5507  !add active contraction stress values
5508  !Be aware for modified DZDNU, should active contraction be added here? Normally should be okay as modified DZDNU and DZDNU
5509  !converge during the Newton iteration.
5510  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
5511  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
5512  dof_idx=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
5513  & gauss_points(gauss_point_number,element_number)
5514  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
5515  & field_values_set_type,dof_idx,VALUE,err,error,*999)
5516  stress_tensor(component_idx)=stress_tensor(component_idx)+VALUE
5517  ENDDO
5518  ENDIF
5519 
5520  !Do push-forward of 2nd Piola tensor.
5521  CALL finite_elasticity_push_stress_tensor(stress_tensor,mod_dzdnu,jznu,err,error,*999)
5522  !Calculate isochoric Cauchy tensor (the deviatoric part) and add the volumetric part (the hydrostatic pressure).
5523  onethird_trace=sum(stress_tensor(1:3))/3.0_dp
5524  stress_tensor(1:3)=stress_tensor(1:3)-onethird_trace+p
5525 
5526  CASE(equations_set_transverse_isotropic_guccione_subtype,equations_set_guccione_activecontraction_subtype)
5527  pressure_component=dependent_interpolated_point%INTERPOLATION_PARAMETERS%FIELD_VARIABLE%NUMBER_OF_COMPONENTS
5528  p=dependent_interpolated_point%VALUES(pressure_component,no_part_deriv)
5529  b=[2.0_dp*c(2),2.0_dp*c(3),2.0_dp*c(3),c(4),c(4),c(3)] ![2*b_f,2*b_t,2*b_t,b_ft,b_ft,b_t]
5530  e=[0.5_dp*(azl(1,1)-1.0_dp),0.5_dp*(azl(2,2)-1.0_dp),0.5_dp*(azl(3,3)-1.0_dp),azl(2,1),azl(3,1),azl(3,2)] !(Modified) strain tensor in Voigt form.
5531  dq_de=b*e
5532  tempterm1=0.5_dp*c(1)*exp(0.5_dp*dot_product(e,dq_de))
5533  ! Calculate isochoric fictitious 2nd Piola tensor (in Voigt form)
5534  stress_tensor=tempterm1*dq_de
5535  IF(equations_set%specification(3)==equations_set_guccione_activecontraction_subtype) THEN
5536  !add active contraction stress values
5537  !Be aware for modified DZDNU, should active contraction be added here? Normally should be okay as modified DZDNU and DZDNU
5538  !converge during the Newton iteration.
5539  CALL field_variable_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,field_variable,err,error,*999)
5540  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
5541  dof_idx=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP% &
5542  & gauss_points(gauss_point_number,element_number)
5543  CALL field_parameter_set_get_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
5544  & field_values_set_type,dof_idx,VALUE,err,error,*999)
5545  stress_tensor(component_idx)=stress_tensor(component_idx)+VALUE
5546  ENDDO
5547  ENDIF
5548  ! Do push-forward of 2nd Piola tensor.
5549  CALL finite_elasticity_push_stress_tensor(stress_tensor,mod_dzdnu,jznu,err,error,*999)
5550  !Calculate isochoric Cauchy tensor (the deviatoric part) and add the volumetric part (the hydrostatic pressure).
5551  onethird_trace=sum(stress_tensor(1:3))/3.0_dp
5552  stress_tensor(1:3)=stress_tensor(1:3)-onethird_trace+p
5553  CASE DEFAULT
5554  local_error="The third equations set specification of "// &
5555  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
5556  & " is not valid for a finite elasticity type of an elasticity equation set."
5557  CALL flagerror(local_error,err,error,*999)
5558  END SELECT
5559 
5560  exits("FINITE_ELASTICITY_GAUSS_STRESS_TENSOR")
5561  RETURN
5562  999 errorsexits("FINITE_ELASTICITY_GAUSS_STRESS_TENSOR",err,error)
5563  RETURN 1
5564  END SUBROUTINE finite_elasticity_gauss_stress_tensor
5565 
5566  !
5567  !================================================================================================================================
5568  !
5569 
5570  ! calculates the current active contraction component using the independent field
5571  ! Uses a hardcoded tension transient based on GPB+NHS with length-dependence for now
5572  SUBROUTINE finiteelasticity_piolaaddactivecontraction(INDEPENDENT_FIELD,MATERIALS_FIELD,PIOLA_FF,E_FF,&
5573  & element_number,gauss_point_number,err,error,*)
5574  !Argument variables
5575  TYPE(field_type), POINTER, INTENT(IN) :: INDEPENDENT_FIELD, MATERIALS_FIELD
5576  REAL(DP), INTENT(INOUT) :: PIOLA_FF
5577  REAL(DP), INTENT(IN) :: E_FF
5578  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER,GAUSS_POINT_NUMBER
5579  INTEGER(INTG), INTENT(OUT) :: ERR
5580  TYPE(varying_string), INTENT(OUT) :: ERROR
5581 
5582  INTEGER(INTG) :: I
5583  REAL(DP) :: S, LAMBDA, ISO_TA, TA, ACTIVTIME, TIME, DT
5584  REAL(DP), DIMENSION(1:4) :: QL
5585 
5586  REAL(DP), PARAMETER :: PERIOD = 1000 ! 1 Hz
5587  REAL(DP), PARAMETER, DIMENSION(28) :: TIMES = [ 0, 20, 30, 40, 60, 80, 100, 120, 150, 160, 170, 175, 180, 190, 200,&
5588  & 225, 250, 300, 333, 366, 400, 450, 500, 600, 700, 800, 900,1000 ] ! simple tension curve based on GPB/NHS: times
5589 
5590  REAL(DP), PARAMETER, DIMENSION(28) :: TENSIONFRAC = [ 0.0194, 0.0193, 0.0200, 0.0254, 0.0778, 0.1713, 0.2794, 0.3708,&
5591  & 0.4472, 0.4578, 0.4624, 0.4627, 0.4618, 0.4567, 0.4478, 0.4121, 0.3614, 0.2326, 0.1471, 0.0920, 0.0681, 0.0526, 0.0438,&
5592  & 0.0332, 0.0271, 0.0234, 0.0210, 0.0194 ] ! simple isometric tension curve based on GPB/NHS: tension/tref
5593  real(dp), PARAMETER :: t_ref = 100 ! reference tension
5594 
5595  enters("FiniteElasticity_PiolaAddActiveContraction",err,error,*999)
5596 
5597  ! Get time, dt, etc from independent field
5598  CALL field_parameter_set_get_constant(independent_field,field_u_variable_type,field_values_set_type, 1, dt,err,error,*999) ! dt
5599  CALL field_parameter_set_get_constant(independent_field,field_u_variable_type,field_values_set_type, 2, time,err,error,*999) ! time
5600  DO i=1,4
5601  CALL field_parametersetgetlocalgausspoint(independent_field,field_u_variable_type,&
5602  & field_values_set_type,gauss_point_number,element_number,2+i,ql(i),err,error,*999) ! Q(1) Q(2) Q(3) Lambda for prev in 3/4/5/6
5603  END DO
5604 
5605  ! get activation time from material field
5606  CALL field_parametersetgetlocalgausspoint(materials_field,field_v_variable_type,&
5607  & field_values_set_type,gauss_point_number,element_number,1,activtime,err,error,*999)
5608 
5609  lambda = sqrt(2*e_ff + 1)
5610  time = max( mod(time, period) - activtime, 0.0) ! start activation at this time
5611 
5612  i = 1
5613  DO WHILE (times(i) <= time) ! find first I such that times(I) >= time
5614  i = i+1
5615  END DO
5616  s = (time - times(i-1)) / (times(i) - times(i-1)) !| linear interpolation of ta/tref
5617  iso_ta = t_ref * (tensionfrac(i-1) * (1-s) + tensionfrac(i) * s) !/ + multiply by tref
5618 
5619  CALL finite_elasticity_fmm(time,dt,ql(4),lambda,ql,iso_ta,ta)
5620 
5621  ql(4) = lambda ! bounds applied in FMM, Qi integrated
5622  DO i=1,4
5623  CALL field_parameter_set_update_gauss_point(independent_field,field_u_variable_type,&
5624  & field_values_set_type,gauss_point_number,element_number, 6+i, ql(i),err,error,*999) ! store Q(1) Q(2) Q(3) Lambda for next in 7/8/9/10
5625  END DO
5626 
5627  piola_ff = piola_ff + ta
5628 
5629  exits("FiniteElasticity_PiolaAddActiveContraction")
5630  RETURN
5631 999 errorsexits("FiniteElasticity_PiolaAddActiveContraction",err,error)
5632  RETURN 1
5633 
5634  END SUBROUTINE finiteelasticity_piolaaddactivecontraction
5635 
5636  !
5637  !================================================================================================================================
5638  !
5639 
5640  ! Implements length and velocity dependence. can be used in both weak and strong coupling
5641  SUBROUTINE finite_elasticity_fmm(TIME,DT,PREV_LAMBDA,CURR_LAMBDA,Q123,ISO_TA,TA)
5642  ! PARAMETERS FROM Niederer Hunter & Smith 2006
5643  REAL(DP), PARAMETER, DIMENSION(1:3) :: A = [-29.0,138.0,129.0] ! 'A'
5644  REAL(DP), PARAMETER, DIMENSION(1:3) :: ALPHA = [0.03,0.13,0.625]
5645  REAL(DP), PARAMETER :: la = 0.35, beta_0 = 4.9 ! 'a'
5646 
5647  REAL(DP), INTENT(INOUT), DIMENSION(:) :: Q123
5648  REAL(DP), INTENT(INOUT) :: CURR_LAMBDA
5649  REAL(DP), INTENT(IN) :: PREV_LAMBDA, DT, TIME, ISO_TA
5650  REAL(DP), INTENT(OUT) :: TA
5651 
5652  REAL(DP) :: QFAC, DLAMBDA_DT, Q, OVERLAP
5653  INTEGER(INTG) :: I
5654 
5655  curr_lambda = min(1.15, max(0.8, curr_lambda)) ! inout -> save this
5656 
5657  IF( time - 1e-10 <= 0.0) THEN ! preload / first step -> update method off
5658  qfac = 1.0
5659  ELSE
5660  dlambda_dt = (curr_lambda - prev_lambda) / dt
5661  DO i=1,3
5662  q123(i) = q123(i) + dt * (a(i) * dlambda_dt - alpha(i) * q123(i))
5663  END DO
5664  q = q123(1)+q123(2)+q123(3)
5665  IF(q < 0.0) THEN
5666  qfac = (la*q + 1.0) / (1.0 - q)
5667  ELSE
5668  qfac = (1.0 + (la+2.0)*q)/(1.0+q);
5669  END IF
5670  END IF
5671 
5672  overlap= 1.0 + beta_0 * (curr_lambda-1.0)
5673  ta = overlap * qfac * iso_ta ! length dep * vel dep * isometric tension
5674  END SUBROUTINE finite_elasticity_fmm
5675 
5676 
5677  !
5678  !================================================================================================================================
5679  !
5680 
5682  SUBROUTINE finite_elasticity_gauss_dfdz(INTERPOLATED_POINT,ELEMENT_NUMBER,GAUSS_POINT_NUMBER,NUMBER_OF_DIMENSIONS, &
5683  & number_of_xi,dfdz,err,error,*)
5684 
5685  !Argument variables
5686  TYPE(field_interpolated_point_type), POINTER :: INTERPOLATED_POINT
5687  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
5688  INTEGER(INTG), INTENT(IN) :: GAUSS_POINT_NUMBER
5689  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_DIMENSIONS
5690  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_XI
5691  REAL(DP), INTENT(OUT) :: DFDZ(:,:,:)
5692  INTEGER(INTG), INTENT(OUT) :: ERR
5693  TYPE(varying_string), INTENT(OUT) :: ERROR
5694  !Local Variables
5695  TYPE(basis_type), POINTER :: COMPONENT_BASIS
5696  TYPE(field_type), POINTER :: FIELD
5697  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
5698  INTEGER(INTG) :: derivative_idx,component_idx1,component_idx2,xi_idx,parameter_idx
5699  REAL(DP) :: DXIDZ(number_of_dimensions,number_of_dimensions),DZDXI(number_of_dimensions,number_of_dimensions)
5700  REAL(DP) :: Jzxi,DFDXI(number_of_dimensions,64,number_of_xi)!temporary until a proper alternative is found
5701 
5702  enters("FINITE_ELASTICITY_GAUSS_DFDZ",err,error,*999)
5703 
5704  !Initialise DFDXI array
5705  dfdxi=0.0_dp ! DFDXI(component_idx,parameter_idx,xi_idx)
5706  dfdz=0.0_dp
5707  DO component_idx2=1,number_of_dimensions !Always 3 spatial coordinates (3D)
5708  DO xi_idx=1,number_of_xi !Thus always 3 element coordinates
5709  derivative_idx=partial_derivative_first_derivative_map(xi_idx) !2,4,7
5710  dzdxi(component_idx2,xi_idx)=interpolated_point%VALUES(component_idx2,derivative_idx) !dz/dxi
5711  ENDDO
5712  ENDDO
5713 
5714  ! Populate a 3 x 3 square dzdXi if this is a membrane problem in 3D space
5715  IF (number_of_dimensions == 3 .AND. number_of_xi == 2) THEN
5716  CALL cross_product(dzdxi(:,1),dzdxi(:,2),dzdxi(:,3),err,error,*999)
5717  dzdxi(:,3) = normalise(dzdxi(:,3),err,error)
5718  ENDIF
5719 
5720  CALL invert(dzdxi,dxidz,jzxi,err,error,*999) !dxi/dz
5721 
5722  field=>interpolated_point%INTERPOLATION_PARAMETERS%FIELD
5723  DO component_idx1=1,number_of_dimensions
5724  component_basis=>field%VARIABLES(1)%COMPONENTS(component_idx1)%DOMAIN%TOPOLOGY%ELEMENTS% &
5725  & elements(element_number)%BASIS
5726  quadrature_scheme=>component_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5727  DO parameter_idx=1,component_basis%NUMBER_OF_ELEMENT_PARAMETERS
5728  DO xi_idx=1,number_of_xi
5729  derivative_idx=partial_derivative_first_derivative_map(xi_idx)
5730  dfdxi(component_idx1,parameter_idx,xi_idx)=quadrature_scheme%GAUSS_BASIS_FNS(parameter_idx,derivative_idx, &
5731  & gauss_point_number)
5732  ENDDO
5733  ENDDO
5734  ENDDO
5735 
5736  DO component_idx1=1,number_of_dimensions
5737  component_basis=>field%VARIABLES(1)%COMPONENTS(component_idx1)%DOMAIN%TOPOLOGY%ELEMENTS% &
5738  & elements(element_number)%BASIS
5739  DO component_idx2=1,number_of_dimensions
5740  DO parameter_idx=1,component_basis%NUMBER_OF_ELEMENT_PARAMETERS
5741  DO xi_idx=1,number_of_xi
5742  dfdz(parameter_idx,component_idx2,component_idx1)=dfdz(parameter_idx,component_idx2,component_idx1) + &
5743  & dfdxi(component_idx1,parameter_idx,xi_idx) * dxidz(xi_idx,component_idx2)
5744  ENDDO
5745  ENDDO
5746  ENDDO
5747  ENDDO
5748 
5749  exits("FINITE_ELASTICITY_GAUSS_DFDZ")
5750  RETURN
5751 999 errorsexits("FINITE_ELASTICITY_GAUSS_DFDZ",err,error)
5752  RETURN 1
5753  END SUBROUTINE finite_elasticity_gauss_dfdz
5754 
5755  !
5756  !================================================================================================================================
5757  !
5758 
5760  SUBROUTINE finite_elasticity_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
5761 
5762  !Argument variables
5763  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5764  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
5765  INTEGER(INTG), INTENT(OUT) :: ERR
5766  TYPE(varying_string), INTENT(OUT) :: ERROR
5767  !Local Variables
5768  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,NUMBER_OF_COMPONENTS, &
5769  & NUMBER_OF_DIMENSIONS, NUMBER_OF_DARCY_COMPONENTS,GEOMETRIC_COMPONENT_NUMBER,NUMBER_OF_COMPONENTS_2,component_idx, &
5770  & derivedIdx,varIdx,variableType,NUMBER_OF_FLUID_COMPONENTS
5771  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
5772  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
5773  TYPE(equations_type), POINTER :: EQUATIONS
5774  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
5775  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5776  TYPE(equations_set_equations_set_field_type), POINTER :: EQUATIONS_EQUATIONS_SET_FIELD
5777  TYPE(field_type), POINTER :: EQUATIONS_SET_FIELD_FIELD
5778  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
5779  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
5780  TYPE(varying_string) :: LOCAL_ERROR
5781  LOGICAL :: IS_HYDROSTATIC_PRESSURE_DEPENDENT_FIELD
5782  INTEGER(INTG) :: num_var,Ncompartments,DEPENDENT_FIELD_NUMBER_OF_VARIABLES
5783  INTEGER(INTG) :: EQUATIONS_SET_FIELD_NUMBER_OF_VARIABLES,EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS
5784  INTEGER(INTG), POINTER :: EQUATIONS_SET_FIELD_DATA(:)
5785  INTEGER(INTG), ALLOCATABLE :: VARIABLE_TYPES(:)
5786  INTEGER(INTG) :: EQUATIONS_SET_SUBTYPE
5787 
5788  enters("FINITE_ELASTICITY_EQUATIONS_SET_SETUP",err,error,*999)
5789 
5790  NULLIFY(geometric_decomposition)
5791  NULLIFY(equations)
5792  NULLIFY(equations_mapping)
5793  NULLIFY(equations_matrices)
5794  NULLIFY(equations_materials)
5795  NULLIFY(equations_equations_set_field)
5796  NULLIFY(equations_set_field_field)
5797  NULLIFY(equations_set_field_data)
5798 
5799  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
5800  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
5801  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
5802  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
5803  & err,error,*999)
5804  END IF
5805  equations_set_subtype=equations_set%SPECIFICATION(3)
5806  is_hydrostatic_pressure_dependent_field = equations_set_subtype/=equations_set_compressible_finite_elasticity_subtype &
5807  & .AND. equations_set_subtype/=equations_set_compressible_activecontraction_subtype &
5808  & .AND. equations_set_subtype/=equations_set_membrane_subtype &
5809  & .AND. equations_set_subtype/=equations_set_elasticity_darcy_inria_model_subtype &
5810  & .AND. equations_set_subtype/=equations_set_elasticity_fluid_pressure_static_inria_subtype &
5811  & .AND. equations_set_subtype/=equations_set_elasticity_fluid_pressure_holmes_mow_subtype &
5812  & .AND. equations_set_subtype/=equations_set_elasticity_fluid_pres_holmes_mow_active_subtype &
5813  & .AND. equations_set_subtype/=equations_set_nearly_incompressible_mooney_rivlin_subtype
5814 
5815  number_of_dimensions = equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
5816 
5817  IF(is_hydrostatic_pressure_dependent_field) THEN
5818  number_of_components = number_of_dimensions + 1
5819  ELSE
5820  number_of_components = number_of_dimensions
5821  ENDIF
5822 
5823  IF(ASSOCIATED(equations_set)) THEN
5824  SELECT CASE(equations_set_subtype)
5825  CASE(equations_set_mooney_rivlin_subtype,equations_set_membrane_subtype, &
5826  & equations_set_mooney_rivlin_activecontraction_subtype, &
5827  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
5828  & equations_set_isotropic_exponential_subtype,equations_set_transverse_isotropic_active_subtype, &
5829  & equations_set_trans_isotropic_active_transition_subtype, &
5830  & equations_set_transverse_isotropic_exponential_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
5831  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
5832  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype, &
5833  & equations_set_compressible_activecontraction_subtype,&
5834  & equations_set_activecontraction_subtype, equations_set_no_subtype, &
5835  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
5836  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
5837  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
5838  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
5839  & equations_set_incompressible_elast_multi_comp_darcy_subtype,equations_set_transverse_isotropic_guccione_subtype, &
5840  & equations_set_guccione_activecontraction_subtype, &
5841  & equations_set_constitutive_law_in_cellml_evaluate_subtype, &
5842  & equations_set_constitutive_and_growth_law_in_cellml_subtype, &
5843  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
5844  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
5845  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype,equations_set_transverse_isotropic_humphrey_yin_subtype, &
5846  & equations_set_standard_monodomain_elasticity_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
5847  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
5848  & equations_set_active_strain_subtype,equations_set_multiscale_active_strain_subtype, &
5849  & equations_set_1d3d_monodomain_active_strain_subtype, &
5850  & equations_set_holzapfel_ogden_activecontraction_subtype)
5851  SELECT CASE(equations_set_setup%SETUP_TYPE)
5852  CASE(equations_set_setup_initial_type)
5853  SELECT CASE(equations_set_setup%ACTION_TYPE)
5854  CASE(equations_set_setup_start_action)
5855  !Default to FEM solution method
5856  CALL finiteelasticity_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
5857  & err,error,*999)
5858  IF(equations_set_subtype==equations_set_incompressible_elast_multi_comp_darcy_subtype) THEN
5859  !setup equations set field to store number of fluid compartments
5860  equations_set_field_number_of_variables = 1
5861  equations_set_field_number_of_components = 2
5862  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
5863  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
5864  !Create the auto created equations set field
5865  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
5866  & equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
5867  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
5868  CALL field_label_set(equations_set_field_field,"Equations Set Field",err,error,*999)
5869  CALL field_type_set_and_lock(equations_set_field_field,field_general_type,&
5870  & err,error,*999)
5871  CALL field_dependent_type_set_and_lock(equations_set_field_field,&
5872  & field_independent_type,err,error,*999)
5873  CALL field_number_of_variables_set(equations_set_field_field, &
5874  & equations_set_field_number_of_variables,err,error,*999)
5875  CALL field_variable_types_set_and_lock(equations_set_field_field,&
5876  & [field_u_variable_type],err,error,*999)
5877  CALL field_dimension_set_and_lock(equations_set_field_field,field_u_variable_type, &
5878  & field_vector_dimension_type,err,error,*999)
5879  CALL field_data_type_set_and_lock(equations_set_field_field,field_u_variable_type, &
5880  & field_intg_type,err,error,*999)
5881  CALL field_number_of_components_set_and_lock(equations_set_field_field,&
5882  & field_u_variable_type,equations_set_field_number_of_components,err,error,*999)
5883  ELSE
5884  !Check the user specified field
5885  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
5886  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
5887  CALL field_number_of_variables_check(equations_set_setup%FIELD,equations_set_field_number_of_variables, &
5888  & err,error,*999)
5889  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
5890  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
5891  & err,error,*999)
5892  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_intg_type,err,error,*999)
5893  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
5894  & equations_set_field_number_of_components,err,error,*999)
5895  ENDIF
5896  ENDIF
5897  CASE(equations_set_setup_finish_action)
5898  IF(equations_set_subtype==equations_set_incompressible_elast_multi_comp_darcy_subtype)THEN
5899  IF(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
5900  CALL field_create_finish(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
5901  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,&
5902  & field_u_variable_type,field_values_set_type, 1, 1_intg, err, error, *999)
5903  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,&
5904  & field_u_variable_type,field_values_set_type, 2, 1_intg, err, error, *999)
5905  ENDIF
5906  ENDIF
5907 !!TODO: Check valid setup
5908  CASE DEFAULT
5909  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
5910  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
5911  & " is invalid for a finite elasticity equation."
5912  CALL flagerror(local_error,err,error,*999)
5913  END SELECT
5914  CASE(equations_set_setup_geometry_type)
5915  !\todo Check dimension of geometric field
5916  SELECT CASE(equations_set_setup%ACTION_TYPE)
5917  CASE(equations_set_setup_start_action)
5918  ! Check whether a fibre field is required, and if so, make sure it has been set
5919  SELECT CASE(equations_set_subtype)
5920  CASE(equations_set_mooney_rivlin_subtype, &
5921  & equations_set_mooney_rivlin_activecontraction_subtype, &
5922  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
5923  & equations_set_isotropic_exponential_subtype, &
5924  & equations_set_compressible_finite_elasticity_subtype,&
5925  & equations_set_compressible_activecontraction_subtype,&
5926  & equations_set_no_subtype, &
5927  & equations_set_membrane_subtype, &
5928  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
5929  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
5930  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
5931  & equations_set_nearly_incompressible_mooney_rivlin_subtype)
5932  ! pass, fibre field isn't required as the constitutive relation is isotropic
5933  CASE(equations_set_orthotropic_material_costa_subtype, &
5934  & equations_set_transverse_isotropic_exponential_subtype, &
5935  & equations_set_transverse_isotropic_polynomial_subtype, &
5936  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
5937  & equations_set_transverse_isotropic_active_subtype, &
5938  & equations_set_trans_isotropic_active_transition_subtype, &
5939  & equations_set_activecontraction_subtype, &
5940  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
5941  & equations_set_incompressible_mooney_rivlin_subtype, &
5942  & equations_set_transverse_isotropic_guccione_subtype, &
5943  & equations_set_guccione_activecontraction_subtype, &
5944  & equations_set_constitutive_law_in_cellml_evaluate_subtype, &
5945  & equations_set_constitutive_and_growth_law_in_cellml_subtype, &
5946  & equations_set_incompressible_elast_multi_comp_darcy_subtype, &
5947  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
5948  & equations_set_standard_monodomain_elasticity_subtype, &
5949  & equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_w_titin_subtype, &
5950  & equations_set_monodomain_elasticity_velocity_subtype,equations_set_active_strain_subtype, &
5951  & equations_set_multiscale_active_strain_subtype,equations_set_1d3d_monodomain_active_strain_subtype, &
5952  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
5953  & equations_set_holzapfel_ogden_activecontraction_subtype)
5954  IF(.NOT.ASSOCIATED(equations_set%GEOMETRY%FIBRE_FIELD)) CALL flagerror( &
5955  & "Finite elascitiy equations require a fibre field.",err,error,*999)
5956  CASE DEFAULT
5957  local_error="The third equations set specification of "// &
5958  & trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
5959  & " is invalid for a finite elasticity equation."
5960  CALL flagerror(local_error,err,error,*999)
5961  END SELECT
5962  IF(equations_set_subtype==equations_set_incompressible_finite_elasticity_darcy_subtype .OR. &
5963  & equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype .OR. &
5964  & equations_set_subtype==equations_set_elasticity_darcy_inria_model_subtype .OR. &
5965  & equations_set_subtype==equations_set_incompressible_elast_multi_comp_darcy_subtype) THEN
5966  ! Set up mesh displacement and equations set field info for elasticity Darcy problems
5967  field_variable=>equations_set%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
5968  CALL field_parametersetensurecreated(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
5969  & field_mesh_displacement_set_type,err,error,*999)
5970  IF(equations_set_subtype==equations_set_multi_compartment_darcy_subtype .OR. &
5971  equations_set_subtype==equations_set_incompressible_elast_multi_comp_darcy_subtype) THEN
5972  !Create the equations set field for multi-compartment Darcy
5973  equations_set_field_number_of_components = 2
5974 
5975  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
5976  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
5977 
5978  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
5979  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
5980  CALL field_mesh_decomposition_set_and_lock(equations_set_field_field,&
5981  & geometric_decomposition,err,error,*999)
5982  CALL field_geometric_field_set_and_lock(equations_set_field_field,&
5983  & equations_set%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
5984  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
5985  & 1,geometric_component_number,err,error,*999)
5986  DO component_idx = 1, equations_set_field_number_of_components
5987  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
5988  & field_u_variable_type,component_idx,geometric_component_number,err,error,*999)
5989  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
5990  & field_u_variable_type,component_idx,field_constant_interpolation,err,error,*999)
5991  END DO
5992 
5993  !Default the field scaling to that of the geometric field
5994  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
5995  CALL field_scaling_type_set(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,geometric_scaling_type, &
5996  & err,error,*999)
5997  ELSE
5998  !Do nothing
5999  ENDIF
6000  ENDIF
6001  END IF
6002  CASE(equations_set_setup_finish_action)
6003  ! do nothing
6004  CASE DEFAULT
6005  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
6006  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
6007  & " is invalid for a linear diffusion equation."
6008  CALL flagerror(local_error,err,error,*999)
6009  END SELECT
6010  CASE(equations_set_setup_dependent_type)
6011  SELECT CASE(equations_set_subtype)
6012  !-----------------------------------------------------------------------
6013  ! Dependent field setup for single-physics
6014  !-----------------------------------------------------------------------
6015  CASE(equations_set_mooney_rivlin_subtype, &
6016  & equations_set_mooney_rivlin_activecontraction_subtype, &
6017  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
6018  & equations_set_isotropic_exponential_subtype,equations_set_transverse_isotropic_active_subtype, &
6019  & equations_set_trans_isotropic_active_transition_subtype, &
6020  & equations_set_transverse_isotropic_exponential_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
6021  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
6022  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype,&
6023  & equations_set_compressible_activecontraction_subtype, &
6024  & equations_set_activecontraction_subtype, equations_set_no_subtype,equations_set_membrane_subtype, &
6025  & equations_set_orthotropic_material_holzapfel_ogden_subtype,equations_set_transverse_isotropic_guccione_subtype, &
6026  & equations_set_guccione_activecontraction_subtype, &
6027  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
6028  & equations_set_standard_monodomain_elasticity_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
6029  & equations_set_1d3d_monodomain_active_strain_subtype, &
6030  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
6031  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_active_strain_subtype, &
6032  & equations_set_multiscale_active_strain_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
6033  & equations_set_holzapfel_ogden_activecontraction_subtype)
6034  SELECT CASE(equations_set_setup%ACTION_TYPE)
6035  CASE(equations_set_setup_start_action)
6036  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6037  !Create the auto created dependent field
6038  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
6039  & dependent_field,err,error,*999)
6040  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
6041  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_geometric_general_type,err,error,*999)
6042  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
6043  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
6044  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
6045  & err,error,*999)
6046  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
6047  & geometric_field,err,error,*999)
6048  IF(equations_set_subtype==equations_set_active_strain_subtype) THEN
6049  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,3,err,error,*999)
6050  ELSE IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6051  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
6052  ELSE
6053  dependent_field_number_of_variables=2
6054  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6055  & dependent_field_number_of_variables,err,error,*999)
6056  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
6057  & field_deludeln_variable_type],err,error,*999)
6058  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6059  & "U",err,error,*999)
6060  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6061  & "del U/del n",err,error,*999)
6062  END IF
6063  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6064  & field_vector_dimension_type,err,error,*999)
6065  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6066  & field_vector_dimension_type,err,error,*999)
6067  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6068  & field_dp_type,err,error,*999)
6069  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6070  & field_dp_type,err,error,*999)
6071  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6072  & number_of_dimensions,err,error,*999)
6073  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6074  & number_of_components,err,error,*999)
6075  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6076  & field_deludeln_variable_type,number_of_components,err,error,*999)
6077  IF(equations_set_subtype==equations_set_active_strain_subtype) THEN
6078  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6079  & field_vector_dimension_type,err,error,*999)
6080  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6081  & field_dp_type,err,error,*999)
6082  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6083  & field_v_variable_type,number_of_dimensions,err,error,*999)
6084  ELSE IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6085  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6086  & field_vector_dimension_type,err,error,*999)
6087  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6088  & field_dp_type,err,error,*999)
6089  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6090  & field_v_variable_type,number_of_dimensions,err,error,*999)
6091  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6092  & field_vector_dimension_type,err,error,*999)
6093  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6094  & field_dp_type,err,error,*999)
6095  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6096  & field_u1_variable_type,2,err,error,*999)
6097  END IF
6098 
6099  !Default to the geometric interpolation setup
6100  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6101  & 1,geometric_mesh_component,err,error,*999)
6102  DO component_idx=1,number_of_dimensions
6103  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6104  & component_idx,geometric_mesh_component,err,error,*999)
6105  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6106  & component_idx,geometric_mesh_component,err,error,*999)
6107  IF(equations_set_subtype==equations_set_active_strain_subtype) THEN
6108  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6109  & field_v_variable_type,component_idx,geometric_mesh_component,err,error,*999)
6110  ELSE IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6111  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6112  & field_v_variable_type,component_idx,geometric_mesh_component,err,error,*999)
6113  END IF
6114  ENDDO !component_idx
6115 
6116  IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6117  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6118  & field_u1_variable_type,1,geometric_mesh_component,err,error,*999)
6119  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6120  & field_u1_variable_type,2,geometric_mesh_component,err,error,*999)
6121  END IF
6122 
6123  IF(is_hydrostatic_pressure_dependent_field) THEN
6124 !kmith :09.06.09 - Do we need this ?
6125  !Set the hydrostatic component to that of the first geometric component
6126  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6127  & 1,geometric_mesh_component,err,error,*999)
6128  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6129  & number_of_components,geometric_mesh_component,err,error,*999)
6130  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6131  & number_of_components,geometric_mesh_component,err,error,*999)
6132 !kmith
6133  ENDIF
6134  SELECT CASE(equations_set%SOLUTION_METHOD)
6135  CASE(equations_set_fem_solution_method)
6136  !Set the displacement components to node based interpolation
6137  DO component_idx=1,number_of_dimensions
6138 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
6139 ! & component_idx,FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
6140 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, &
6141 ! & FIELD_DELUDELN_VARIABLE_TYPE,component_idx,FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
6142  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6143  & component_idx,field_node_based_interpolation,err,error,*999)
6144  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6145  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6146  ENDDO !component_idx
6147  IF(is_hydrostatic_pressure_dependent_field) THEN
6148  !Set the hydrostatic pressure component to element based interpolation
6149  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6150  & number_of_components,field_element_based_interpolation,err,error,*999)
6151  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6152  & field_deludeln_variable_type,number_of_components,field_element_based_interpolation,err,error,*999)
6153  ENDIF
6154  !Default the scaling to the geometric field scaling
6155  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
6156  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
6157  CASE(equations_set_bem_solution_method)
6158  CALL flagerror("Not implemented.",err,error,*999)
6159  CASE(equations_set_fd_solution_method)
6160  CALL flagerror("Not implemented.",err,error,*999)
6161  CASE(equations_set_fv_solution_method)
6162  CALL flagerror("Not implemented.",err,error,*999)
6163  CASE(equations_set_gfem_solution_method)
6164  CALL flagerror("Not implemented.",err,error,*999)
6165  CASE(equations_set_gfv_solution_method)
6166  CALL flagerror("Not implemented.",err,error,*999)
6167  CASE DEFAULT
6168  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6169  & " is invalid."
6170  CALL flagerror(local_error,err,error,*999)
6171  END SELECT
6172  ELSE
6173  !Check the user specified field
6174  CALL field_type_check(equations_set_setup%FIELD,field_geometric_general_type,err,error,*999)
6175  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
6176  IF(equations_set_subtype==equations_set_active_strain_subtype) THEN
6177  CALL field_number_of_variables_check(equations_set_setup%FIELD,3,err,error,*999)
6178  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
6179  & field_v_variable_type],err,error,*999)
6180  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type, &
6181  & err,error,*999)
6182  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
6183  ELSE IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6184  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
6185  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
6186  & field_v_variable_type,field_u1_variable_type],err,error,*999)
6187  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type,&
6188  & err,error,*999)
6189  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
6190  CALL field_dimension_check(equations_set_setup%FIELD,field_u1_variable_type,field_vector_dimension_type,&
6191  & err,error,*999)
6192  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
6193  ELSE
6194  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
6195  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type],&
6196  & err,error,*999)
6197  END IF
6198  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
6199  & err,error,*999)
6200  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
6201  & err,error,*999)
6202  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
6203  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
6204  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6205  & number_of_dimensions,err,error,*999)
6206  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
6207  & err,error,*999)
6208  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components, &
6209  & err,error,*999)
6210  IF(equations_set_subtype==equations_set_active_strain_subtype) THEN
6211  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
6212  & number_of_dimensions,err,error,*999)
6213  ELSE IF(equations_set_subtype==equations_set_multiscale_active_strain_subtype) THEN
6214  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
6215  & number_of_dimensions,err,error,*999)
6216  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type, &
6217  & 2,err,error,*999)
6218  END IF
6219  !Check that the pressure values set type is created here?? (second variable is a DELUDELN type, as checked above)
6220  !\todo: Decide whether these set_types (previous one as well) is to be created by user or automatically..
6221  IF(.not.ASSOCIATED(equations_set_setup%FIELD%VARIABLES(2)%PARAMETER_SETS% &
6222  & set_type(field_pressure_values_set_type)%PTR)) THEN
6223  local_error="Variable 2 of type "//trim(number_to_vstring(equations_set_setup%FIELD%VARIABLES(2)% &
6224  & variable_type,"*",err,error))//" does not have a pressure values set type associated."
6225  ENDIF
6226  SELECT CASE(equations_set%SOLUTION_METHOD)
6227  CASE(equations_set_fem_solution_method)
6228  DO component_idx=1,number_of_dimensions
6229  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
6230  & field_node_based_interpolation,err,error,*999)
6231  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,component_idx, &
6232  & field_node_based_interpolation,err,error,*999)
6233  ENDDO !component_idx
6234  CASE(equations_set_bem_solution_method)
6235  CALL flagerror("Not implemented.",err,error,*999)
6236  CASE(equations_set_fd_solution_method)
6237  CALL flagerror("Not implemented.",err,error,*999)
6238  CASE(equations_set_fv_solution_method)
6239  CALL flagerror("Not implemented.",err,error,*999)
6240  CASE(equations_set_gfem_solution_method)
6241  CALL flagerror("Not implemented.",err,error,*999)
6242  CASE(equations_set_gfv_solution_method)
6243  CALL flagerror("Not implemented.",err,error,*999)
6244  CASE DEFAULT
6245  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6246  & " is invalid."
6247  CALL flagerror(local_error,err,error,*999)
6248  END SELECT
6249  ENDIF
6250  CASE(equations_set_setup_finish_action)
6251  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6252  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
6253  ENDIF
6254  IF(equations_set%specification(3)==equations_set_monodomain_elasticity_velocity_subtype) THEN
6255  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6256  & field_previous_values_set_type,err,error,*999)
6257  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6258  & field_previous_iteration_values_set_type,err,error,*999)
6259  ENDIF
6260  CASE DEFAULT
6261  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
6262  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
6263  & " is invalid for a finite elasticity equation"
6264  CALL flagerror(local_error,err,error,*999)
6265  END SELECT
6266 
6267  !-------------------------------------------------------------------------------
6268  ! Dependent field setup for elasticity evaluated in CellML
6269  !-------------------------------------------------------------------------------
6270  CASE(equations_set_constitutive_law_in_cellml_evaluate_subtype, &
6271  & equations_set_constitutive_and_growth_law_in_cellml_subtype)
6272  SELECT CASE(equations_set_setup%ACTION_TYPE)
6273  CASE(equations_set_setup_start_action)
6274  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6275  !Create the auto created dependent field
6276  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
6277  & dependent_field,err,error,*999)
6278  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_geometric_general_type,err,error,*999)
6279  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
6280  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
6281  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
6282  & err,error,*999)
6283  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
6284  & geometric_field,err,error,*999)
6285  IF(number_of_dimensions==3) THEN
6286  number_of_components_2 = 6
6287  ELSE IF(number_of_dimensions==2) THEN
6288  number_of_components_2 = 3
6289  ELSE
6290  CALL flagerror("Only 2 and 3 dimensional problems are implemented at the moment",err,error,*999)
6291  ENDIF !NUMBER_OF_DIMENSIONS
6292  IF(equations_set%SPECIFICATION(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6293  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,5,err,error,*999)
6294  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
6295  & field_deludeln_variable_type,field_u1_variable_type,field_u2_variable_type,field_u3_variable_type], &
6296  & err,error,*999)
6297  ELSE
6298  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
6299  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
6300  & field_deludeln_variable_type,field_u1_variable_type,field_u2_variable_type],err,error,*999)
6301  ENDIF
6302  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6303  & field_vector_dimension_type,err,error,*999)
6304  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6305  & field_vector_dimension_type,err,error,*999)
6306  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6307  & field_vector_dimension_type,err,error,*999)
6308  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
6309  & field_vector_dimension_type,err,error,*999)
6310  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6311  & field_dp_type,err,error,*999)
6312  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6313  & field_dp_type,err,error,*999)
6314  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6315  & field_dp_type,err,error,*999)
6316  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
6317  & field_dp_type,err,error,*999)
6318  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6319  & number_of_dimensions,err,error,*999)
6320  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6321  & number_of_components,err,error,*999)
6322  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6323  & field_deludeln_variable_type,number_of_components,err,error,*999)
6324  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6325  & number_of_components_2,err,error,*999)
6326  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
6327  & number_of_components_2,err,error,*999)
6328 
6329  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6330  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u3_variable_type, &
6331  & field_vector_dimension_type,err,error,*999)
6332  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u3_variable_type, &
6333  & field_dp_type,err,error,*999)
6334  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u3_variable_type, &
6335  & number_of_dimensions,err,error,*999)
6336  ENDIF
6337 
6338  !Default to the geometric interpolation setup
6339  DO component_idx=1,number_of_dimensions
6340  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6341  & component_idx,geometric_mesh_component,err,error,*999)
6342  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6343  & component_idx,geometric_mesh_component,err,error,*999)
6344  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6345  & component_idx,geometric_mesh_component,err,error,*999)
6346  ENDDO !component_idx
6347 
6348  IF(is_hydrostatic_pressure_dependent_field) THEN
6349 !kmith :09.06.09 - Do we need this ?
6350  !Set the hydrostatic component to that of the first geometric component
6351  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6352  & 1,geometric_mesh_component,err,error,*999)
6353  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6354  & number_of_components,geometric_mesh_component,err,error,*999)
6355  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6356  & number_of_components,geometric_mesh_component,err,error,*999)
6357 !kmith
6358  ENDIF
6359 
6360  !Set the stress and strain components to that of the first geometric component
6361  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6362  & 1,geometric_mesh_component,err,error,*999)
6363  DO component_idx=1,number_of_components_2
6364  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
6365  & component_idx,geometric_mesh_component,err,error,*999)
6366  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
6367  & component_idx,geometric_mesh_component,err,error,*999)
6368  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6369  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u3_variable_type, &
6370  & component_idx,geometric_mesh_component,err,error,*999)
6371  ENDIF
6372  ENDDO !component_idx
6373 
6374  SELECT CASE(equations_set%SOLUTION_METHOD)
6375  CASE(equations_set_fem_solution_method)
6376  !Set the displacement components to node based interpolation
6377  DO component_idx=1,number_of_dimensions
6378  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6379  & component_idx,field_node_based_interpolation,err,error,*999)
6380  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6381  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6382  ENDDO !component_idx
6383 
6384  IF(is_hydrostatic_pressure_dependent_field) THEN
6385  !Set the hydrostatic pressure component to element based interpolation
6386  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6387  & number_of_components,field_element_based_interpolation,err,error,*999)
6388  CALL field_component_interpolation_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6389  & field_deludeln_variable_type,number_of_components,field_element_based_interpolation,err,error,*999)
6390  ENDIF
6391 
6392  !Set the stress and strain components to gauss point interpolation
6393  DO component_idx=1,number_of_components_2
6394  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6395  & field_u1_variable_type,component_idx,field_gauss_point_based_interpolation,err,error,*999)
6396  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6397  & field_u2_variable_type,component_idx,field_gauss_point_based_interpolation,err,error,*999)
6398  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6399  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6400  & field_u3_variable_type,component_idx,field_gauss_point_based_interpolation,err,error,*999)
6401  ENDIF
6402  ENDDO !component_idx
6403 
6404  !Default the scaling to the geometric field scaling
6405  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
6406  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
6407  CASE(equations_set_bem_solution_method)
6408  CALL flagerror("Not implemented.",err,error,*999)
6409  CASE(equations_set_fd_solution_method)
6410  CALL flagerror("Not implemented.",err,error,*999)
6411  CASE(equations_set_fv_solution_method)
6412  CALL flagerror("Not implemented.",err,error,*999)
6413  CASE(equations_set_gfem_solution_method)
6414  CALL flagerror("Not implemented.",err,error,*999)
6415  CASE(equations_set_gfv_solution_method)
6416  CALL flagerror("Not implemented.",err,error,*999)
6417  CASE DEFAULT
6418  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6419  & " is invalid."
6420  CALL flagerror(local_error,err,error,*999)
6421  END SELECT
6422 
6423  ELSE !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED
6424 
6425  !Check the user specified field
6426  CALL field_type_check(equations_set_setup%FIELD,field_geometric_general_type,err,error,*999)
6427  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
6428  IF(number_of_dimensions==3) THEN
6429  number_of_components_2 = 6
6430  ELSE IF(number_of_dimensions==2) THEN
6431  number_of_components_2 = 3
6432  ELSE
6433  CALL flagerror("Only 2 and 3 dimensional problems are implemented at the moment",err,error,*999)
6434  ENDIF !NUMBER_OF_DIMENSIONS
6435  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6436  CALL field_number_of_variables_check(equations_set_setup%FIELD,5,err,error,*999)
6437  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
6438  & field_u1_variable_type,field_u2_variable_type,field_u3_variable_type],err,error,*999)
6439  ELSE
6440  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
6441  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
6442  & field_u1_variable_type,field_u2_variable_type],err,error,*999)
6443  ENDIF
6444  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
6445  & err,error,*999)
6446  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
6447  & err,error,*999)
6448  CALL field_dimension_check(equations_set_setup%FIELD,field_u1_variable_type,field_vector_dimension_type, &
6449  & err,error,*999)
6450  CALL field_dimension_check(equations_set_setup%FIELD,field_u2_variable_type,field_vector_dimension_type, &
6451  & err,error,*999)
6452  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
6453  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
6454  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
6455  CALL field_data_type_check(equations_set_setup%FIELD,field_u2_variable_type,field_dp_type,err,error,*999)
6456  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6457  & number_of_dimensions,err,error,*999)
6458  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
6459  & err,error,*999)
6460  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
6461  & number_of_components,err,error,*999)
6462  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type,number_of_components_2, &
6463  & err,error,*999)
6464  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u2_variable_type,number_of_components_2, &
6465  & err,error,*999)
6466  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6467  CALL field_dimension_check(equations_set_setup%FIELD,field_u3_variable_type,field_vector_dimension_type, &
6468  & err,error,*999)
6469  CALL field_data_type_check(equations_set_setup%FIELD,field_u3_variable_type,field_dp_type,err,error,*999)
6470  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u3_variable_type,number_of_dimensions, &
6471  & err,error,*999)
6472  ENDIF
6473 
6474  !Check that the pressure values set type is created here?? (second variable is a DELUDELN type, as checked above)
6475  !\todo: Decide whether these set_types (previous one as well) is to be created by user or automatically..
6476  IF(.not.ASSOCIATED(equations_set_setup%FIELD%VARIABLES(2)%PARAMETER_SETS% &
6477  & set_type(field_pressure_values_set_type)%PTR)) THEN
6478  local_error="Variable 2 of type "//trim(number_to_vstring(equations_set_setup%FIELD%VARIABLES(2)% &
6479  & variable_type,"*",err,error))//" does not have a pressure values set type associated."
6480  ENDIF
6481  SELECT CASE(equations_set%SOLUTION_METHOD)
6482  CASE(equations_set_fem_solution_method)
6483  DO component_idx=1,number_of_dimensions
6484  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
6485  & field_node_based_interpolation,err,error,*999)
6486  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,component_idx, &
6487  & field_node_based_interpolation,err,error,*999)
6488  IF(equations_set%specification(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
6489  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u3_variable_type,component_idx, &
6490  & field_gauss_point_based_interpolation,err,error,*999)
6491  ENDIF
6492  ENDDO !component_idx
6493  DO component_idx=1,number_of_components_2
6494  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,component_idx, &
6495  & field_gauss_point_based_interpolation,err,error,*999)
6496  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,component_idx, &
6497  & field_gauss_point_based_interpolation,err,error,*999)
6498  ENDDO !component_idx
6499 
6500  CASE(equations_set_bem_solution_method)
6501  CALL flagerror("Not implemented.",err,error,*999)
6502  CASE(equations_set_fd_solution_method)
6503  CALL flagerror("Not implemented.",err,error,*999)
6504  CASE(equations_set_fv_solution_method)
6505  CALL flagerror("Not implemented.",err,error,*999)
6506  CASE(equations_set_gfem_solution_method)
6507  CALL flagerror("Not implemented.",err,error,*999)
6508  CASE(equations_set_gfv_solution_method)
6509  CALL flagerror("Not implemented.",err,error,*999)
6510  CASE DEFAULT
6511  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6512  & " is invalid."
6513  CALL flagerror(local_error,err,error,*999)
6514  END SELECT
6515  ENDIF !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED
6516  CASE(equations_set_setup_finish_action)
6517  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6518  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
6519  ENDIF
6520  CASE DEFAULT
6521  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
6522  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
6523  & " is invalid for a finite elasticity equation"
6524  CALL flagerror(local_error,err,error,*999)
6525  END SELECT
6526 
6527  !-------------------------------------------------------------------------------
6528  ! Shared Dependent field setup for multi-physics: elasticity coupled with Darcy
6529  !-------------------------------------------------------------------------------
6530  CASE(equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
6531  & equations_set_incompressible_elasticity_driven_darcy_subtype)
6532  SELECT CASE(equations_set_setup%ACTION_TYPE)
6533  CASE(equations_set_setup_start_action)
6534  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6535  !Create the auto created dependent field
6536  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
6537  & dependent_field,err,error,*999)
6538  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
6539  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
6540  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
6541  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
6542  & err,error,*999)
6543  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
6544  & geometric_field,err,error,*999)
6545  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
6546  CALL field_variable_types_set_and_lock(equations_set_setup%FIELD,[field_u_variable_type, &
6547  & field_deludeln_variable_type,field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
6548  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6549  & field_vector_dimension_type,err,error,*999)
6550  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6551  & field_vector_dimension_type,err,error,*999)
6552  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6553  & field_vector_dimension_type,err,error,*999)
6554  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6555  & field_vector_dimension_type,err,error,*999)
6556  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6557  & field_dp_type,err,error,*999)
6558  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6559  & field_dp_type,err,error,*999)
6560  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6561  & field_dp_type,err,error,*999)
6562  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6563  & field_dp_type,err,error,*999)
6564  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6565  & number_of_dimensions,err,error,*999)
6566  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6567  & number_of_components,err,error,*999)
6568  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6569  & number_of_components,err,error,*999)
6570 
6571  SELECT CASE(equations_set_subtype)
6572  CASE(equations_set_elasticity_darcy_inria_model_subtype)
6573  number_of_darcy_components=number_of_dimensions+2 !for INRIA model: velocity components, pressure, mass increase
6574  CASE (equations_set_incompressible_finite_elasticity_darcy_subtype)
6575  number_of_darcy_components=number_of_dimensions+1 !for standard Darcy: velocity components and pressure
6576  CASE (equations_set_incompressible_elasticity_driven_darcy_subtype)
6577  number_of_darcy_components=number_of_dimensions+1 !for Darcy with pressure driven by solid: velocity components and mass increase
6578  END SELECT
6579 
6580  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6581  & number_of_darcy_components,err,error,*999)
6582  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6583  & number_of_darcy_components,err,error,*999)
6584 
6585  !Elasticity: Default to the geometric interpolation setup
6586  DO component_idx=1,number_of_dimensions
6587  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6588  & component_idx,geometric_mesh_component,err,error,*999)
6589  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6590  & component_idx,geometric_mesh_component,err,error,*999)
6591  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6592  & component_idx,geometric_mesh_component,err,error,*999)
6593  ENDDO !component_idx
6594 
6595  IF (is_hydrostatic_pressure_dependent_field) THEN
6596 !kmith :09.0.06.09 - Do we need this ?
6597  !Set the hydrostatic component to that of the first geometric component
6598  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6599  & 1,geometric_mesh_component,err,error,*999)
6600  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6601  & number_of_components,geometric_mesh_component,err,error,*999)
6602  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6603  & number_of_components,geometric_mesh_component,err,error,*999)
6604 !kmith
6605  ENDIF
6606 
6607  !Darcy: Default to the geometric interpolation setup
6608  DO component_idx=1,number_of_dimensions
6609  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6610  & component_idx,geometric_mesh_component,err,error,*999)
6611  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6612  & component_idx,geometric_mesh_component,err,error,*999)
6613  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6614  & component_idx,geometric_mesh_component,err,error,*999)
6615  ENDDO !component_idx
6616 
6617  !Darcy: Default pressure and, if present, mass increase to the first geometric component
6618  DO component_idx=number_of_dimensions+1,number_of_darcy_components
6619  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6620  & 1,geometric_mesh_component,err,error,*999)
6621  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6622  & component_idx,geometric_mesh_component,err,error,*999)
6623  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6624  & component_idx,geometric_mesh_component,err,error,*999)
6625  ENDDO !component_idx
6626 
6627  SELECT CASE(equations_set%SOLUTION_METHOD)
6628  CASE(equations_set_fem_solution_method)
6629  !Elasticity: Set the displacement components to node based interpolation
6630  DO component_idx=1,number_of_dimensions
6631  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6632  & component_idx,field_node_based_interpolation,err,error,*999)
6633  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6634  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6635  ENDDO !component_idx
6636 
6637  IF (equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
6638  !Elasticity: Set the hydrostatic pressure component to node based interpolation
6639  !as this is used as the pressure field for the Darcy equations
6640  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6641  & number_of_components,field_node_based_interpolation,err,error,*999)
6642  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6643  & field_deludeln_variable_type,number_of_components,field_node_based_interpolation,err,error,*999)
6644  ELSE IF (is_hydrostatic_pressure_dependent_field) THEN
6645  !Elasticity: Set the hydrostatic pressure component to element based interpolation
6646  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6647  & number_of_components,field_element_based_interpolation,err,error,*999)
6648  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6649  & field_deludeln_variable_type,number_of_components,field_element_based_interpolation,err,error,*999)
6650  ENDIF
6651 
6652  !Darcy: Set the velocity, pressure and, if present, mass increase components to node based interpolation
6653  DO component_idx=1,number_of_darcy_components
6654  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6655  & component_idx,field_node_based_interpolation,err,error,*999)
6656  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6657  & field_delvdeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6658  ENDDO !component_idx
6659 
6660  !Default the scaling to the geometric field scaling
6661  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
6662  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
6663  CASE(equations_set_bem_solution_method)
6664  CALL flagerror("Not implemented.",err,error,*999)
6665  CASE(equations_set_fd_solution_method)
6666  CALL flagerror("Not implemented.",err,error,*999)
6667  CASE(equations_set_fv_solution_method)
6668  CALL flagerror("Not implemented.",err,error,*999)
6669  CASE(equations_set_gfem_solution_method)
6670  CALL flagerror("Not implemented.",err,error,*999)
6671  CASE(equations_set_gfv_solution_method)
6672  CALL flagerror("Not implemented.",err,error,*999)
6673  CASE DEFAULT
6674  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6675  & " is invalid."
6676  CALL flagerror(local_error,err,error,*999)
6677  END SELECT
6678  ELSE
6679  !Check the user specified field
6680  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
6681  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
6682  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
6683  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type,&
6684  & field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
6685 
6686  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
6687  & err,error,*999)
6688  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
6689  & err,error,*999)
6690  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type, &
6691  & err,error,*999)
6692  CALL field_dimension_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_vector_dimension_type, &
6693  & err,error,*999)
6694 
6695  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
6696  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
6697  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
6698  CALL field_data_type_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_dp_type,err,error,*999)
6699  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6700  & number_of_dimensions,err,error,*999)
6701  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
6702  & err,error,*999)
6703  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components, &
6704  & err,error,*999)
6705 
6706  SELECT CASE(equations_set_subtype)
6707  CASE(equations_set_elasticity_darcy_inria_model_subtype)
6708  number_of_darcy_components=number_of_dimensions+2 !for INRIA model: velocity components, pressure, mass increase
6709  CASE (equations_set_incompressible_finite_elasticity_darcy_subtype)
6710  number_of_darcy_components=number_of_dimensions+1 !for standard Darcy: velocity components and pressure
6711  CASE (equations_set_incompressible_elasticity_driven_darcy_subtype)
6712  number_of_darcy_components=number_of_dimensions+1 !for Darcy with pressure driven by solid: velocity components and mass increase
6713  END SELECT
6714 
6715  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,number_of_darcy_components, &
6716  & err,error,*999)
6717  CALL field_number_of_components_check(equations_set_setup%FIELD,field_delvdeln_variable_type, &
6718  & number_of_darcy_components,err,error,*999)
6719 
6720  !Check that the impermeability flag values set type is created here??
6721  !\todo: Decide whether these set_types is to be created by user or automatically..
6722  IF(.not.ASSOCIATED(equations_set_setup%FIELD%VARIABLES(4)%PARAMETER_SETS% &
6723  & set_type(field_impermeable_flag_values_set_type)%PTR)) THEN
6724  local_error="Variable 4 of type "//trim(number_to_vstring(equations_set_setup% &
6725  & field%VARIABLES(4)% &
6726  & variable_type,"*",err,error))//" does not have an impermeable flag values set type associated."
6727  ENDIF
6728 
6729  SELECT CASE(equations_set%SOLUTION_METHOD)
6730  CASE(equations_set_fem_solution_method)
6731  !Elasticity:
6732  DO component_idx=1,number_of_dimensions
6733  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
6734  & field_node_based_interpolation,err,error,*999)
6735  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,component_idx, &
6736  & field_node_based_interpolation,err,error,*999)
6737  ENDDO !component_idx
6738  IF(equations_set_subtype==equations_set_incompressible_elasticity_driven_darcy_subtype) THEN
6739  !If solid hydrostatic pressure is driving Darcy flow, check that pressure uses node based interpolation
6740  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,4, &
6741  & field_node_based_interpolation,err,error,*999)
6742  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,4, &
6743  & field_node_based_interpolation,err,error,*999)
6744  ENDIF
6745  !Darcy:
6746  DO component_idx=1,number_of_darcy_components
6747  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,component_idx, &
6748  & field_node_based_interpolation,err,error,*999)
6749  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_delvdeln_variable_type,component_idx, &
6750  & field_node_based_interpolation,err,error,*999)
6751  ENDDO !component_idx
6752 
6753  CASE(equations_set_bem_solution_method)
6754  CALL flagerror("Not implemented.",err,error,*999)
6755  CASE(equations_set_fd_solution_method)
6756  CALL flagerror("Not implemented.",err,error,*999)
6757  CASE(equations_set_fv_solution_method)
6758  CALL flagerror("Not implemented.",err,error,*999)
6759  CASE(equations_set_gfem_solution_method)
6760  CALL flagerror("Not implemented.",err,error,*999)
6761  CASE(equations_set_gfv_solution_method)
6762  CALL flagerror("Not implemented.",err,error,*999)
6763  CASE DEFAULT
6764  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6765  & " is invalid."
6766  CALL flagerror(local_error,err,error,*999)
6767  END SELECT
6768  ENDIF
6769  CASE(equations_set_setup_finish_action)
6770  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6771  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
6772  ENDIF
6773  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6774  & field_initial_values_set_type,err,error,*999)
6775  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6776  & field_relative_velocity_set_type,err,error,*999)
6777  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6778  & field_previous_iteration_values_set_type,err,error,*999)
6779 
6780  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6781  & field_impermeable_flag_values_set_type,err,error,*999)
6782  CASE DEFAULT
6783  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
6784  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
6785  & " is invalid for a finite elasticity equation"
6786  CALL flagerror(local_error,err,error,*999)
6787  END SELECT
6788  !---------------------------------------------------------------------------------------------
6789  ! Shared Dependent field setup for multi-physics: elasticity coupled with Darcy fluid pressure
6790  !---------------------------------------------------------------------------------------------
6791  CASE(equations_set_elasticity_fluid_pressure_static_inria_subtype, &
6792  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
6793  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype)
6794  number_of_darcy_components=1 !Only solving for the fluid pressure at the moment
6795  SELECT CASE(equations_set_setup%ACTION_TYPE)
6796  CASE(equations_set_setup_start_action)
6797  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6798  !Create the auto created dependent field
6799  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
6800  & dependent_field,err,error,*999)
6801  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_geometric_general_type,err,error,*999)
6802  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
6803  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
6804  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
6805  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
6806  & err,error,*999)
6807  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
6808  & geometric_field,err,error,*999)
6809  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
6810  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
6811  & field_deludeln_variable_type,field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
6812  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6813  & field_vector_dimension_type,err,error,*999)
6814  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6815  & field_vector_dimension_type,err,error,*999)
6816  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6817  & field_vector_dimension_type,err,error,*999)
6818  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6819  & field_vector_dimension_type,err,error,*999)
6820  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6821  & field_dp_type,err,error,*999)
6822  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6823  & field_dp_type,err,error,*999)
6824  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6825  & field_dp_type,err,error,*999)
6826  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6827  & field_dp_type,err,error,*999)
6828  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6829  & number_of_dimensions,err,error,*999)
6830  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6831  & number_of_components,err,error,*999)
6832  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6833  & number_of_components,err,error,*999)
6834  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6835  & number_of_darcy_components,err,error,*999)
6836  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6837  & number_of_darcy_components,err,error,*999)
6838 
6839  !Set labels
6840  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"U",err,error,*999)
6841  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del U/del n", &
6842  & err,error,*999)
6843  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,"V",err,error,*999)
6844  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type,"del V/del n", &
6845  & err,error,*999)
6846  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1,"x1",err,error,*999)
6847  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,2,"x2",err,error,*999)
6848  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,3,"x3",err,error,*999)
6849  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
6850  & "del x1/del n",err,error,*999)
6851  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,2, &
6852  & "del x2/del n",err,error,*999)
6853  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,3, &
6854  & "del x3/del n",err,error,*999)
6855  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1,"p",err,error,*999)
6856  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
6857  & "del p/del n",err,error,*999)
6858 
6859  !Elasticity: Default to the geometric interpolation setup
6860  DO component_idx=1,number_of_dimensions
6861  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6862  & component_idx,geometric_mesh_component,err,error,*999)
6863  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6864  & component_idx,geometric_mesh_component,err,error,*999)
6865  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
6866  & component_idx,geometric_mesh_component,err,error,*999)
6867  ENDDO !component_idx
6868  !Darcy: Default pressure and mass increase to the first geometric component
6869  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6870  & 1,geometric_mesh_component,err,error,*999)
6871  DO component_idx=1,number_of_darcy_components
6872  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6873  & component_idx,geometric_mesh_component,err,error,*999)
6874  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
6875  & component_idx,geometric_mesh_component,err,error,*999)
6876  ENDDO !component_idx
6877 
6878  SELECT CASE(equations_set%SOLUTION_METHOD)
6879  CASE(equations_set_fem_solution_method)
6880  !Elasticity: Set the displacement components to node based interpolation
6881  DO component_idx=1,number_of_dimensions
6882  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6883  & component_idx,field_node_based_interpolation,err,error,*999)
6884  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6885  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6886  ENDDO !component_idx
6887  !Darcy: Set the pressure and mass increase components to node based interpolation
6888  DO component_idx=1,number_of_darcy_components
6889  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
6890  & component_idx,field_node_based_interpolation,err,error,*999)
6891  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
6892  & field_delvdeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
6893  ENDDO !component_idx
6894 
6895  !Default the scaling to the geometric field scaling
6896  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
6897  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
6898  CASE(equations_set_bem_solution_method)
6899  CALL flagerror("Not implemented.",err,error,*999)
6900  CASE(equations_set_fd_solution_method)
6901  CALL flagerror("Not implemented.",err,error,*999)
6902  CASE(equations_set_fv_solution_method)
6903  CALL flagerror("Not implemented.",err,error,*999)
6904  CASE(equations_set_gfem_solution_method)
6905  CALL flagerror("Not implemented.",err,error,*999)
6906  CASE(equations_set_gfv_solution_method)
6907  CALL flagerror("Not implemented.",err,error,*999)
6908  CASE DEFAULT
6909  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6910  & " is invalid."
6911  CALL flagerror(local_error,err,error,*999)
6912  END SELECT
6913  ELSE
6914  !Check the user specified field
6915  CALL field_type_check(equations_set_setup%FIELD,field_geometric_general_type,err,error,*999)
6916  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
6917  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
6918  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
6919  & field_v_variable_type,field_delvdeln_variable_type] &
6920  & ,err,error,*999)
6921  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
6922  & err,error,*999)
6923  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
6924  & err,error,*999)
6925  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type, &
6926  & err,error,*999)
6927  CALL field_dimension_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_vector_dimension_type, &
6928  & err,error,*999)
6929 
6930  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
6931  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
6932  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
6933  CALL field_data_type_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_dp_type,err,error,*999)
6934  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
6935  & number_of_dimensions,err,error,*999)
6936  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
6937  & number_of_components,err,error,*999)
6938  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
6939  & number_of_components,err,error,*999)
6940  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
6941  & number_of_darcy_components,err,error,*999)
6942  CALL field_number_of_components_check(equations_set_setup%FIELD,field_delvdeln_variable_type, &
6943  & number_of_darcy_components,err,error,*999)
6944 
6945  SELECT CASE(equations_set%SOLUTION_METHOD)
6946  CASE(equations_set_fem_solution_method)
6947  !Elasticity:
6948  DO component_idx=1,number_of_dimensions
6949  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
6950  & field_node_based_interpolation,err,error,*999)
6951  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,component_idx, &
6952  & field_node_based_interpolation,err,error,*999)
6953  ENDDO !component_idx
6954  !Darcy:
6955  DO component_idx=1,number_of_darcy_components
6956  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,component_idx, &
6957  & field_node_based_interpolation,err,error,*999)
6958  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_delvdeln_variable_type,component_idx, &
6959  & field_node_based_interpolation,err,error,*999)
6960  ENDDO !component_idx
6961 
6962  CASE(equations_set_bem_solution_method)
6963  CALL flagerror("Not implemented.",err,error,*999)
6964  CASE(equations_set_fd_solution_method)
6965  CALL flagerror("Not implemented.",err,error,*999)
6966  CASE(equations_set_fv_solution_method)
6967  CALL flagerror("Not implemented.",err,error,*999)
6968  CASE(equations_set_gfem_solution_method)
6969  CALL flagerror("Not implemented.",err,error,*999)
6970  CASE(equations_set_gfv_solution_method)
6971  CALL flagerror("Not implemented.",err,error,*999)
6972  CASE DEFAULT
6973  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
6974  & " is invalid."
6975  CALL flagerror(local_error,err,error,*999)
6976  END SELECT
6977  ENDIF
6978  CASE(equations_set_setup_finish_action)
6979  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6980  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
6981  ENDIF
6982  CASE DEFAULT
6983  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
6984  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
6985  & " is invalid for a finite elasticity equation"
6986  CALL flagerror(local_error,err,error,*999)
6987  END SELECT
6988  !-------------------------------------------------------------------------------
6989  ! Shared Dependent field setup for multi-physics: elasticity coupled with multi-compartment Darcy
6990  !-------------------------------------------------------------------------------
6991  CASE(equations_set_incompressible_elast_multi_comp_darcy_subtype)
6992  SELECT CASE(equations_set_setup%ACTION_TYPE)
6993  CASE(equations_set_setup_start_action)
6994  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
6995  !Create the auto created dependent field
6996  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
6997  & dependent_field,err,error,*999)
6998  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_geometric_general_type,err,error,*999)
6999  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
7000  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7001  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
7002  & err,error,*999)
7003  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
7004  & geometric_field,err,error,*999)
7005  !Get the number of Darcy compartments from the equations set field
7006  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
7007  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
7008  & field_values_set_type,equations_set_field_data,err,error,*999)
7009  ncompartments=equations_set_field_data(2)
7010  !Set number of variables to be 2+2*Ncompartments
7011  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(2+2*ncompartments), &
7012  & err,error,*999)
7013  ALLOCATE(variable_types(2*ncompartments+2))
7014  DO num_var=1,ncompartments+1
7015  variable_types(2*num_var-1)=field_u_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7016  variable_types(2*num_var)=field_deludeln_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7017  ENDDO
7018  CALL field_variable_types_set_and_lock(equations_set_setup%FIELD,variable_types,err,error,*999)
7019  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7020  & number_of_dimensions,err,error,*999)
7021  number_of_components=number_of_dimensions+1
7022  number_of_darcy_components=number_of_dimensions+1 !for Darcy with pressure driven by solid: velocity components and mass increase
7023 
7024  DO num_var=1,2*ncompartments+2
7025  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7026  & field_vector_dimension_type,err,error,*999)
7027  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7028  & field_dp_type,err,error,*999)
7029  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7030  & number_of_components,err,error,*999)
7031  ENDDO
7032 
7033 ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
7034 ! & NUMBER_OF_COMPONENTS,ERR,ERROR,*999)
7035 ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
7036 ! & NUMBER_OF_COMPONENTS,ERR,ERROR,*999)
7037 ! NUMBER_OF_DARCY_COMPONENTS=NUMBER_OF_DIMENSIONS+1 !for Darcy with pressure driven by solid: velocity components and mass increase
7038 ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
7039 ! & NUMBER_OF_DARCY_COMPONENTS,ERR,ERROR,*999)
7040 ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELVDELN_VARIABLE_TYPE, &
7041 ! & NUMBER_OF_DARCY_COMPONENTS,ERR,ERROR,*999)
7042 
7043  !Elasticity: Default to the geometric interpolation setup
7044  DO component_idx=1,number_of_dimensions
7045  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7046  & component_idx,geometric_mesh_component,err,error,*999)
7047  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7048  & component_idx,geometric_mesh_component,err,error,*999)
7049  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
7050  & component_idx,geometric_mesh_component,err,error,*999)
7051  ENDDO !component_idx
7052 
7053  !Set the hydrostatic component to that of the first geometric component
7054  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7055  & 1,geometric_mesh_component,err,error,*999)
7056  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7057  & number_of_components,geometric_mesh_component,err,error,*999)
7058  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
7059  & number_of_components,geometric_mesh_component,err,error,*999)
7060  DO num_var=3,2*ncompartments+2
7061  !Darcy: Default to the geometric interpolation setup
7062  DO component_idx=1,number_of_dimensions
7063  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7064  & component_idx,geometric_mesh_component,err,error,*999)
7065  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7066  & component_idx,geometric_mesh_component,err,error,*999)
7067  ENDDO !component_idx
7068  !Darcy: Default pressure and, if present, mass increase to the first geometric component
7069  DO component_idx=number_of_dimensions+1,number_of_darcy_components
7070  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7071  & 1,geometric_mesh_component,err,error,*999)
7072  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7073  & component_idx,geometric_mesh_component,err,error,*999)
7074  ENDDO !component_idx
7075  ENDDO
7076  SELECT CASE(equations_set%SOLUTION_METHOD)
7077  CASE(equations_set_fem_solution_method)
7078  !Elasticity: Set the displacement components to node based interpolation
7079  DO component_idx=1,number_of_dimensions
7080  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7081  & component_idx,field_node_based_interpolation,err,error,*999)
7082  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7083  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
7084  ENDDO !component_idx
7085 
7086 ! IF (EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) THEN
7087  !Elasticity: Set the hydrostatic pressure component to node based interpolation
7088  !as this is used as the pressure field for the Darcy equations
7089  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7090  & number_of_components,field_node_based_interpolation,err,error,*999)
7091  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7092  & field_deludeln_variable_type,number_of_components,field_node_based_interpolation,err,error,*999)
7093 ! ELSE IF (IS_HYDROSTATIC_PRESSURE_DEPENDENT_FIELD) THEN
7094 ! !Elasticity: Set the hydrostatic pressure component to element based interpolation
7095 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
7096 ! & NUMBER_OF_COMPONENTS,FIELD_ELEMENT_BASED_INTERPOLATION,ERR,ERROR,*999)
7097 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, &
7098 ! & FIELD_DELUDELN_VARIABLE_TYPE,NUMBER_OF_COMPONENTS,FIELD_ELEMENT_BASED_INTERPOLATION,ERR,ERROR,*999)
7099 ! ENDIF
7100  DO num_var=3,2*ncompartments+2
7101  !Darcy: Set the velocity, pressure and, if present, mass increase components to node based interpolation
7102  DO component_idx=1,number_of_darcy_components
7103  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7104  & variable_types(num_var),component_idx,field_node_based_interpolation,err,error,*999)
7105  ENDDO !component_idx
7106  ENDDO
7107  !Default the scaling to the geometric field scaling
7108  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7109  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7110  CASE(equations_set_bem_solution_method)
7111  CALL flagerror("Not implemented.",err,error,*999)
7112  CASE(equations_set_fd_solution_method)
7113  CALL flagerror("Not implemented.",err,error,*999)
7114  CASE(equations_set_fv_solution_method)
7115  CALL flagerror("Not implemented.",err,error,*999)
7116  CASE(equations_set_gfem_solution_method)
7117  CALL flagerror("Not implemented.",err,error,*999)
7118  CASE(equations_set_gfv_solution_method)
7119  CALL flagerror("Not implemented.",err,error,*999)
7120  CASE DEFAULT
7121  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7122  & " is invalid."
7123  CALL flagerror(local_error,err,error,*999)
7124  END SELECT
7125  ELSE
7126  !Check the user specified field
7127  CALL field_type_check(equations_set_setup%FIELD,field_geometric_general_type,err,error,*999)
7128  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
7129  !Get the number of Darcy compartments from the equations set field
7130  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
7131  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
7132  & field_values_set_type,equations_set_field_data,err,error,*999)
7133  ncompartments=equations_set_field_data(2)
7134  CALL field_number_of_variables_check(equations_set_setup%FIELD,(2+2*ncompartments),err,error,*999)
7135  ALLOCATE(variable_types(2*ncompartments+2))
7136  DO num_var=1,ncompartments+1
7137  variable_types(2*num_var-1)=field_u_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7138  variable_types(2*num_var)=field_deludeln_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7139  ENDDO
7140  CALL field_variable_types_check(equations_set_setup%FIELD,variable_types,err,error,*999)
7141 
7142  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7143  & number_of_dimensions,err,error,*999)
7144  number_of_components=number_of_dimensions+1
7145  number_of_darcy_components=number_of_dimensions+1
7146 
7147  DO num_var=1,2*ncompartments+2
7148  CALL field_dimension_check(equations_set_setup%FIELD,variable_types(num_var),field_vector_dimension_type, &
7149  & err,error,*999)
7150  CALL field_data_type_check(equations_set_setup%FIELD,variable_types(num_var),field_dp_type,err,error,*999)
7151  CALL field_number_of_components_check(equations_set_setup%FIELD,variable_types(num_var),number_of_components, &
7152  & err,error,*999)
7153 
7154  ENDDO
7155 
7156  SELECT CASE(equations_set%SOLUTION_METHOD)
7157  CASE(equations_set_fem_solution_method)
7158  !Elasticity:
7159  DO component_idx=1,number_of_dimensions
7160  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
7161  & field_node_based_interpolation,err,error,*999)
7162  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,component_idx, &
7163  & field_node_based_interpolation,err,error,*999)
7164  ENDDO !component_idx
7165  !If solid hydrostatic pressure is driving Darcy flow, check that pressure uses node based interpolation
7166  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
7167  & field_node_based_interpolation,err,error,*999)
7168  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
7169  & number_of_components,field_node_based_interpolation,err,error,*999)
7170 
7171  DO num_var=3,2*ncompartments+2
7172  !Darcy:
7173  DO component_idx=1,number_of_darcy_components
7174  CALL field_component_interpolation_check(equations_set_setup%FIELD,variable_types(num_var),component_idx, &
7175  & field_node_based_interpolation,err,error,*999)
7176  ENDDO !component_idx
7177  ENDDO
7178  CASE(equations_set_bem_solution_method)
7179  CALL flagerror("Not implemented.",err,error,*999)
7180  CASE(equations_set_fd_solution_method)
7181  CALL flagerror("Not implemented.",err,error,*999)
7182  CASE(equations_set_fv_solution_method)
7183  CALL flagerror("Not implemented.",err,error,*999)
7184  CASE(equations_set_gfem_solution_method)
7185  CALL flagerror("Not implemented.",err,error,*999)
7186  CASE(equations_set_gfv_solution_method)
7187  CALL flagerror("Not implemented.",err,error,*999)
7188  CASE DEFAULT
7189  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7190  & " is invalid."
7191  CALL flagerror(local_error,err,error,*999)
7192  END SELECT
7193  DEALLOCATE(variable_types)
7194  ENDIF
7195  CASE(equations_set_setup_finish_action)
7196  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
7197  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
7198  ENDIF
7199  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
7200  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
7201  & field_values_set_type,equations_set_field_data,err,error,*999)
7202  ncompartments=equations_set_field_data(2)
7203  ALLOCATE(variable_types(2*ncompartments+2))
7204  DO num_var=1,ncompartments+1
7205  variable_types(2*num_var-1)=field_u_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7206  variable_types(2*num_var)=field_deludeln_variable_type+(field_number_of_variable_subtypes*(num_var-1))
7207  ENDDO
7208  DO num_var=3,2*ncompartments+2
7209  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7210  & field_initial_values_set_type,err,error,*999)
7211  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7212  & field_relative_velocity_set_type,err,error,*999)
7213  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,variable_types(num_var), &
7214  & field_previous_iteration_values_set_type,err,error,*999)
7215  ENDDO
7216  DEALLOCATE(variable_types)
7217  CASE DEFAULT
7218  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
7219  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
7220  & " is invalid for a finite elasticity equation"
7221  CALL flagerror(local_error,err,error,*999)
7222  END SELECT
7223  !end: Dependent field setup for elasticity coupled with Darcy
7224  CASE DEFAULT
7225  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
7226  & " is invalid for a finite elasticity equation"
7227  CALL flagerror(local_error,err,error,*999)
7228  END SELECT
7229 
7230 
7231  !-----------------------------------------------------------------
7232  ! I n d e p e n d e n t f i e l d
7233  !-----------------------------------------------------------------
7234  CASE(equations_set_setup_independent_type)
7235  SELECT CASE(equations_set_setup%ACTION_TYPE)
7236  CASE(equations_set_setup_start_action)
7237 
7238  SELECT CASE(equations_set_subtype)
7239  ! ACTIVE CONTRACTION
7240  CASE(equations_set_activecontraction_subtype)
7241  number_of_components = 10 ! dt t Q1 Q2 Q3 lambda prev Q1 Q2 Q3 lambda
7242  IF(equations_set%SOLUTION_METHOD /= equations_set_fem_solution_method .OR. &
7243  &.NOT. equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7244  CALL flagerror("Not implemented.",err,error,*999)
7245  END IF
7246  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7247  & independent_field,err,error,*999)
7248  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7249 
7250  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7251  & err,error,*999)
7252  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7253  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7254  & err,error,*999)
7255 
7256  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7257  & geometric_field,err,error,*999)
7258  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7259  & number_of_components,err,error,*999)
7260 
7261  DO component_idx=1,2 ! dt t constant
7262  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7263  & field_u_variable_type,component_idx,field_constant_interpolation,err,error,*999)
7264  END DO
7265 
7266  DO component_idx=3,number_of_components ! other gauss pt based
7267  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7268  & field_u_variable_type,component_idx,field_gauss_point_based_interpolation,err,error,*999)
7269  END DO
7270 
7271  !Mooney Rivlin, St Venant Kirchoff and Compressible active contraction subtype
7272  CASE(equations_set_mooney_rivlin_activecontraction_subtype,equations_set_stvenant_kirchoff_activecontraction_subtype, &
7273  & equations_set_compressible_activecontraction_subtype, equations_set_holzapfel_ogden_activecontraction_subtype, &
7274  & equations_set_guccione_activecontraction_subtype)
7275  number_of_components = 3 !one contractile stress value for each of the three directions
7276  IF(equations_set%SOLUTION_METHOD /= equations_set_fem_solution_method .OR. &
7277  &.NOT. equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7278  CALL flagerror("Not implemented.",err,error,*999)
7279  END IF
7280  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7281  & independent_field,err,error,*999)
7282  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7283 
7284  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7285  & err,error,*999)
7286  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7287  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7288  & err,error,*999)
7289 
7290  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7291  & geometric_field,err,error,*999)
7292  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7293  & number_of_components,err,error,*999)
7294 
7295  !Set component to be gauss point based
7296  DO component_idx=1,number_of_components
7297  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7298  & field_u_variable_type,component_idx,field_gauss_point_based_interpolation,err,error,*999)
7299  ENDDO
7300 
7301 
7302  ! COUPLED DARCY
7303  CASE(equations_set_standard_elasticity_darcy_subtype,equations_set_incompressible_elast_multi_comp_darcy_subtype, &
7304  & equations_set_incompressible_elasticity_driven_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype,&
7305  & equations_set_incompressible_finite_elasticity_darcy_subtype, &
7306  & equations_set_elasticity_multi_compartment_darcy_inria_subtype, &
7307  & equations_set_incompressible_elasticity_driven_mr_subtype,equations_set_mooney_rivlin_subtype)
7308  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7309  !Create the auto created dependent field
7310  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7311  & independent_field,err,error,*999)
7312  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7313  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7314  & err,error,*999)
7315  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7316  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7317  & err,error,*999)
7318  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7319  & geometric_field,err,error,*999)
7320  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,2,err,error,*999)
7321  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7322  & field_vector_dimension_type,err,error,*999)
7323  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_deludeln_variable_type, &
7324  & field_vector_dimension_type,err,error,*999)
7325  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7326  & field_dp_type,err,error,*999)
7327  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_deludeln_variable_type, &
7328  & field_dp_type,err,error,*999)
7329  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7330  & number_of_dimensions,err,error,*999)
7331  number_of_components=number_of_dimensions !+1 !Include hydrostatic pressure component
7332  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7333  & number_of_components,err,error,*999)
7334  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7335  & field_deludeln_variable_type,number_of_components,err,error,*999)
7336  !Default to the geometric interpolation setup
7337  DO component_idx=1,number_of_dimensions
7338  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7339  & component_idx,geometric_mesh_component,err,error,*999)
7340  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7341  & component_idx,geometric_mesh_component,err,error,*999)
7342  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7343  & field_deludeln_variable_type,component_idx,geometric_mesh_component,err,error,*999)
7344  ENDDO !component_idx
7345 
7346 ! !kmith :09.06.09 - Do we need this ?
7347 ! !Set the hydrostatic component to that of the first geometric component
7348 ! CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
7349 ! & 1,GEOMETRIC_MESH_COMPONENT,ERR,ERROR,*999)
7350 ! CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
7351 ! & NUMBER_OF_COMPONENTS,GEOMETRIC_MESH_COMPONENT,ERR,ERROR,*999)
7352 ! CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
7353 ! & NUMBER_OF_COMPONENTS,GEOMETRIC_MESH_COMPONENT,ERR,ERROR,*999)
7354 ! !kmith
7355 
7356  SELECT CASE(equations_set%SOLUTION_METHOD)
7357  CASE(equations_set_fem_solution_method)
7358  !Set the displacement components to node based interpolation
7359  DO component_idx=1,number_of_dimensions
7360  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7361  & field_u_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
7362  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7363  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
7364  ENDDO !component_idx
7365 ! !Set the hydrostatic pressure component to element based interpolation
7366 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, &
7367 ! & FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS,FIELD_ELEMENT_BASED_INTERPOLATION,ERR,ERROR,*999)
7368 ! CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, &
7369 ! & FIELD_DELUDELN_VARIABLE_TYPE,NUMBER_OF_COMPONENTS,FIELD_ELEMENT_BASED_INTERPOLATION,ERR,ERROR,*999)
7370  !Default the scaling to the geometric field scaling
7371  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7372  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7373  CASE(equations_set_bem_solution_method)
7374  CALL flagerror("Not implemented.",err,error,*999)
7375  CASE(equations_set_fd_solution_method)
7376  CALL flagerror("Not implemented.",err,error,*999)
7377  CASE(equations_set_fv_solution_method)
7378  CALL flagerror("Not implemented.",err,error,*999)
7379  CASE(equations_set_gfem_solution_method)
7380  CALL flagerror("Not implemented.",err,error,*999)
7381  CASE(equations_set_gfv_solution_method)
7382  CALL flagerror("Not implemented.",err,error,*999)
7383  CASE DEFAULT
7384  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7385  & " is invalid."
7386  CALL flagerror(local_error,err,error,*999)
7387  END SELECT
7388  ELSE !INDEPENDENT_FIELD_AUTO_CREATED
7389  !Check the user specified field
7390  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
7391  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
7392  !Question:Better to leave it up for the user to play around?
7393  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
7394  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type], &
7395  & err,error,*999)
7396  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type,err, &
7397  & error,*999)
7398  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
7399  & err,error,*999)
7400  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
7401  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
7402  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7403  & number_of_dimensions,err,error,*999)
7404  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
7405  & err,error,*999)
7406  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components,&
7407  & err,error,*999)
7408  SELECT CASE(equations_set%SOLUTION_METHOD)
7409  CASE(equations_set_fem_solution_method)
7410  !DO component_idx=1,NUMBER_OF_DIMENSIONS
7411  ! CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,component_idx, &
7412  ! & FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
7413  ! CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,component_idx, &
7414  ! & FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
7415  !ENDDO !component_idx
7416  CASE(equations_set_bem_solution_method)
7417  CALL flagerror("Not implemented.",err,error,*999)
7418  CASE(equations_set_fd_solution_method)
7419  CALL flagerror("Not implemented.",err,error,*999)
7420  CASE(equations_set_fv_solution_method)
7421  CALL flagerror("Not implemented.",err,error,*999)
7422  CASE(equations_set_gfem_solution_method)
7423  CALL flagerror("Not implemented.",err,error,*999)
7424  CASE(equations_set_gfv_solution_method)
7425  CALL flagerror("Not implemented.",err,error,*999)
7426  CASE DEFAULT
7427  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7428  & " is invalid."
7429  CALL flagerror(local_error,err,error,*999)
7430  END SELECT
7431  ENDIF !INDEPENDENT_FIELD_AUTO_CREATED
7432 
7433  ! BIOELECTRICS COUPLED TO FINITE ELASTICITY
7434  CASE(equations_set_standard_monodomain_elasticity_subtype)
7435  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7436  !Create the auto created dependent field
7437  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7438  & independent_field,err,error,*999)
7439  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7440  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7441  & err,error,*999)
7442  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7443  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7444  & err,error,*999)
7445  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7446  & geometric_field,err,error,*999)
7447  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,1,err,error,*999)
7448  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7449  & field_scalar_dimension_type,err,error,*999)
7450  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7451  & field_dp_type,err,error,*999)
7452  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7453  & 1,err,error,*999)
7454  !Default to the first component of the geometric interpolation setup
7455  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7456  & 1,geometric_mesh_component,err,error,*999)
7457  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7458  & 1,geometric_mesh_component,err,error,*999)
7459 
7460  SELECT CASE(equations_set%SOLUTION_METHOD)
7461  CASE(equations_set_fem_solution_method)
7462  !Set to node based interpolation
7463  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7464  & field_u_variable_type,1,field_gauss_point_based_interpolation,err,error,*999)
7465  !Default the scaling to the geometric field scaling
7466  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7467  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7468  CASE(equations_set_bem_solution_method)
7469  CALL flagerror("Not implemented.",err,error,*999)
7470  CASE(equations_set_fd_solution_method)
7471  CALL flagerror("Not implemented.",err,error,*999)
7472  CASE(equations_set_fv_solution_method)
7473  CALL flagerror("Not implemented.",err,error,*999)
7474  CASE(equations_set_gfem_solution_method)
7475  CALL flagerror("Not implemented.",err,error,*999)
7476  CASE(equations_set_gfv_solution_method)
7477  CALL flagerror("Not implemented.",err,error,*999)
7478  CASE DEFAULT
7479  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7480  & " is invalid."
7481  CALL flagerror(local_error,err,error,*999)
7482  END SELECT
7483  ELSE !INDEPENDENT_FIELD_AUTO_CREATED
7484  !Check the user specified field
7485  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
7486  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
7487  !Question:Better to leave it up for the user to play around?
7488  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
7489  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
7490  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err, &
7491  & error,*999)
7492  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
7493  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1, &
7494  & err,error,*999)
7495  SELECT CASE(equations_set%SOLUTION_METHOD)
7496  CASE(equations_set_fem_solution_method)
7497  !do/check nothing???
7498  CASE(equations_set_bem_solution_method)
7499  CALL flagerror("Not implemented.",err,error,*999)
7500  CASE(equations_set_fd_solution_method)
7501  CALL flagerror("Not implemented.",err,error,*999)
7502  CASE(equations_set_fv_solution_method)
7503  CALL flagerror("Not implemented.",err,error,*999)
7504  CASE(equations_set_gfem_solution_method)
7505  CALL flagerror("Not implemented.",err,error,*999)
7506  CASE(equations_set_gfv_solution_method)
7507  CALL flagerror("Not implemented.",err,error,*999)
7508  CASE DEFAULT
7509  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7510  & " is invalid."
7511  CALL flagerror(local_error,err,error,*999)
7512  END SELECT
7513  ENDIF !INDEPENDENT_FIELD_AUTO_CREATED
7514 
7515  CASE(equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_w_titin_subtype, &
7516  & equations_set_1d3d_monodomain_active_strain_subtype)
7517  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7518  !Create the auto created independent field
7519  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7520  & independent_field,err,error,*999)
7521  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7522  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7523  & err,error,*999)
7524  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7525  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7526  & err,error,*999)
7527  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7528  & geometric_field,err,error,*999)
7529  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,2,err,error,*999)
7530  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type, &
7531  & field_v_variable_type],err,error,*999)
7532  IF(equations_set_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
7533  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7534  & field_scalar_dimension_type,err,error,*999)
7535  ENDIF
7536  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7537  & field_dp_type,err,error,*999)
7538  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
7539  & field_intg_type,err,error,*999)
7540  IF(equations_set_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
7541  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7542  & 1,err,error,*999)
7543  ELSEIF(equations_set_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
7544  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7545  & 6,err,error,*999)
7546  ELSEIF(equations_set_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
7547  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7548  & 5,err,error,*999)
7549  ENDIF
7550  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
7551  & number_of_dimensions+1,err,error,*999)
7552  !Default to the first component of the geometric interpolation setup
7553  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7554  & 1,geometric_mesh_component,err,error,*999)
7555  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7556  & 1,geometric_mesh_component,err,error,*999)
7557  IF(equations_set_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
7558  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7559  & 2,geometric_mesh_component,err,error,*999)
7560  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7561  & 3,geometric_mesh_component,err,error,*999)
7562  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7563  & 4,geometric_mesh_component,err,error,*999)
7564  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7565  & 5,geometric_mesh_component,err,error,*999)
7566  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7567  & 6,geometric_mesh_component,err,error,*999)
7568  ELSEIF(equations_set_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
7569  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7570  & 2,geometric_mesh_component,err,error,*999)
7571  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7572  & 3,geometric_mesh_component,err,error,*999)
7573  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7574  & 4,geometric_mesh_component,err,error,*999)
7575  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7576  & 5,geometric_mesh_component,err,error,*999)
7577  ENDIF
7578  SELECT CASE(equations_set%SOLUTION_METHOD)
7579  CASE(equations_set_fem_solution_method)
7580  !Set to node based interpolation
7581  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7582  & field_u_variable_type,1,field_gauss_point_based_interpolation,err,error,*999)
7583  IF(equations_set_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
7584  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7585  & field_u_variable_type,2,field_gauss_point_based_interpolation,err,error,*999)
7586  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7587  & field_u_variable_type,3,field_gauss_point_based_interpolation,err,error,*999)
7588  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7589  & field_u_variable_type,4,field_gauss_point_based_interpolation,err,error,*999)
7590  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7591  & field_u_variable_type,5,field_gauss_point_based_interpolation,err,error,*999)
7592  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7593  & field_u_variable_type,6,field_gauss_point_based_interpolation,err,error,*999)
7594  ENDIF
7595  DO component_idx=1,number_of_dimensions
7596  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7597  & field_v_variable_type,component_idx,field_element_based_interpolation,err,error,*999)
7598  ENDDO
7599  !Default the scaling to the geometric field scaling
7600  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7601  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7602  CASE(equations_set_bem_solution_method)
7603  CALL flagerror("Not implemented.",err,error,*999)
7604  CASE(equations_set_fd_solution_method)
7605  CALL flagerror("Not implemented.",err,error,*999)
7606  CASE(equations_set_fv_solution_method)
7607  CALL flagerror("Not implemented.",err,error,*999)
7608  CASE(equations_set_gfem_solution_method)
7609  CALL flagerror("Not implemented.",err,error,*999)
7610  CASE(equations_set_gfv_solution_method)
7611  CALL flagerror("Not implemented.",err,error,*999)
7612  CASE DEFAULT
7613  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7614  & " is invalid."
7615  CALL flagerror(local_error,err,error,*999)
7616  END SELECT
7617  ELSE !INDEPENDENT_FIELD_AUTO_CREATED
7618  !Check the user specified field
7619  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
7620  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
7621  !Question:Better to leave it up for the user to play around?
7622  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
7623  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type],err, &
7624  & error,*999)
7625  IF(equations_set_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
7626  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err, &
7627  & error,*999)
7628  ENDIF
7629  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
7630  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_intg_type,err,error,*999)
7631  IF(equations_set_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
7632  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1, &
7633  & err,error,*999)
7634  ELSE IF(equations_set_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
7635  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,6, &
7636  & err,error,*999)
7637  ELSEIF(equations_set_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
7638  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,5, &
7639  & err,error,*999)
7640  ENDIF
7641  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,number_of_dimensions+1, &
7642  & err,error,*999)
7643  SELECT CASE(equations_set%SOLUTION_METHOD)
7644  CASE(equations_set_fem_solution_method)
7645  !do/check nothing???
7646  CASE(equations_set_bem_solution_method)
7647  CALL flagerror("Not implemented.",err,error,*999)
7648  CASE(equations_set_fd_solution_method)
7649  CALL flagerror("Not implemented.",err,error,*999)
7650  CASE(equations_set_fv_solution_method)
7651  CALL flagerror("Not implemented.",err,error,*999)
7652  CASE(equations_set_gfem_solution_method)
7653  CALL flagerror("Not implemented.",err,error,*999)
7654  CASE(equations_set_gfv_solution_method)
7655  CALL flagerror("Not implemented.",err,error,*999)
7656  CASE DEFAULT
7657  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7658  & " is invalid."
7659  CALL flagerror(local_error,err,error,*999)
7660  END SELECT
7661  ENDIF !INDEPENDENT_FIELD_AUTO_CREATED
7662 
7663  CASE(equations_set_monodomain_elasticity_velocity_subtype)
7664  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7665  !Create the auto created independent field
7666  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7667  & independent_field,err,error,*999)
7668  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7669  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7670  & err,error,*999)
7671  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7672  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7673  & err,error,*999)
7674  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7675  & geometric_field,err,error,*999)
7676  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,3,err,error,*999)
7677  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type, &
7678  & field_v_variable_type,field_u1_variable_type],err,error,*999)
7679  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7680  & field_dp_type,err,error,*999)
7681  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
7682  & field_intg_type,err,error,*999)
7683  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
7684  & field_dp_type,err,error,*999)
7685  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7686  & 1,err,error,*999)
7687  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
7688  & number_of_dimensions+1,err,error,*999)
7689  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
7690  & 3,err,error,*999)
7691  !Default to the first component of the geometric interpolation setup
7692  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7693  & 1,geometric_mesh_component,err,error,*999)
7694  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7695  & 1,geometric_mesh_component,err,error,*999)
7696  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7697  & 2,geometric_mesh_component,err,error,*999)
7698  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
7699  & 1,geometric_mesh_component,err,error,*999)
7700  SELECT CASE(equations_set%SOLUTION_METHOD)
7701  CASE(equations_set_fem_solution_method)
7702  !Set to node based interpolation
7703  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7704  & field_u_variable_type,1,field_gauss_point_based_interpolation,err,error,*999)
7705  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7706  & field_u1_variable_type,1,field_gauss_point_based_interpolation,err,error,*999)
7707  DO component_idx=1,number_of_dimensions
7708  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7709  & field_v_variable_type,component_idx,field_element_based_interpolation,err,error,*999)
7710  ENDDO
7711  !Default the scaling to the geometric field scaling
7712  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7713  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7714  CASE(equations_set_bem_solution_method)
7715  CALL flagerror("Not implemented.",err,error,*999)
7716  CASE(equations_set_fd_solution_method)
7717  CALL flagerror("Not implemented.",err,error,*999)
7718  CASE(equations_set_fv_solution_method)
7719  CALL flagerror("Not implemented.",err,error,*999)
7720  CASE(equations_set_gfem_solution_method)
7721  CALL flagerror("Not implemented.",err,error,*999)
7722  CASE(equations_set_gfv_solution_method)
7723  CALL flagerror("Not implemented.",err,error,*999)
7724  CASE DEFAULT
7725  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7726  & " is invalid."
7727  CALL flagerror(local_error,err,error,*999)
7728  END SELECT
7729  ELSE !INDEPENDENT_FIELD_AUTO_CREATED
7730  !Check the user specified field
7731  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
7732  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
7733  !Question:Better to leave it up for the user to play around?
7734  CALL field_number_of_variables_check(equations_set_setup%FIELD,3,err,error,*999)
7735  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type, &
7736  & field_u1_variable_type],err,error,*999)
7737  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
7738  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_intg_type,err,error,*999)
7739  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
7740  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1, &
7741  & err,error,*999)
7742  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,number_of_dimensions+1, &
7743  & err,error,*999)
7744  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type,3, &
7745  & err,error,*999)
7746  SELECT CASE(equations_set%SOLUTION_METHOD)
7747  CASE(equations_set_fem_solution_method)
7748  !do/check nothing???
7749  CASE(equations_set_bem_solution_method)
7750  CALL flagerror("Not implemented.",err,error,*999)
7751  CASE(equations_set_fd_solution_method)
7752  CALL flagerror("Not implemented.",err,error,*999)
7753  CASE(equations_set_fv_solution_method)
7754  CALL flagerror("Not implemented.",err,error,*999)
7755  CASE(equations_set_gfem_solution_method)
7756  CALL flagerror("Not implemented.",err,error,*999)
7757  CASE(equations_set_gfv_solution_method)
7758  CALL flagerror("Not implemented.",err,error,*999)
7759  CASE DEFAULT
7760  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7761  & " is invalid."
7762  CALL flagerror(local_error,err,error,*999)
7763  END SELECT
7764  ENDIF !INDEPENDENT_FIELD_AUTO_CREATED
7765 
7766  CASE(equations_set_multiscale_active_strain_subtype)
7767  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7768  !Create the auto created independent field
7769  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
7770  & independent_field,err,error,*999)
7771  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
7772  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
7773  & err,error,*999)
7774  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7775  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
7776  & err,error,*999)
7777  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
7778  & geometric_field,err,error,*999)
7779  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,1,err,error,*999)
7780  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type],err, &
7781  & error,*999)
7782  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7783  & field_dp_type,err,error,*999)
7784  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7785  & 4,err,error,*999)
7786  !Default to the first component of the geometric interpolation setup
7787  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7788  & 1,geometric_mesh_component,err,error,*999)
7789  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7790  & 1,geometric_mesh_component,err,error,*999)
7791  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7792  & 2,geometric_mesh_component,err,error,*999)
7793  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7794  & 3,geometric_mesh_component,err,error,*999)
7795  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7796  & 4,geometric_mesh_component,err,error,*999)
7797  SELECT CASE(equations_set%SOLUTION_METHOD)
7798  CASE(equations_set_fem_solution_method)
7799  !Set to node based interpolation
7800  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7801  & field_u_variable_type,1,field_gauss_point_based_interpolation,err,error,*999)
7802  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7803  & field_u_variable_type,2,field_gauss_point_based_interpolation,err,error,*999)
7804  !Default the scaling to the geometric field scaling
7805  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
7806  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
7807  CASE(equations_set_bem_solution_method)
7808  CALL flagerror("Not implemented.",err,error,*999)
7809  CASE(equations_set_fd_solution_method)
7810  CALL flagerror("Not implemented.",err,error,*999)
7811  CASE(equations_set_fv_solution_method)
7812  CALL flagerror("Not implemented.",err,error,*999)
7813  CASE(equations_set_gfem_solution_method)
7814  CALL flagerror("Not implemented.",err,error,*999)
7815  CASE(equations_set_gfv_solution_method)
7816  CALL flagerror("Not implemented.",err,error,*999)
7817  CASE DEFAULT
7818  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7819  & " is invalid."
7820  CALL flagerror(local_error,err,error,*999)
7821  END SELECT
7822  ELSE !INDEPENDENT_FIELD_AUTO_CREATED
7823  !Check the user specified field
7824  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
7825  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
7826  !Question:Better to leave it up for the user to play around?
7827  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
7828  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err, &
7829  & error,*999)
7830  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
7831 
7832  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,4, &
7833  & err,error,*999)
7834 
7835  SELECT CASE(equations_set%SOLUTION_METHOD)
7836  CASE(equations_set_fem_solution_method)
7837  !do/check nothing???
7838  CASE(equations_set_bem_solution_method)
7839  CALL flagerror("Not implemented.",err,error,*999)
7840  CASE(equations_set_fd_solution_method)
7841  CALL flagerror("Not implemented.",err,error,*999)
7842  CASE(equations_set_fv_solution_method)
7843  CALL flagerror("Not implemented.",err,error,*999)
7844  CASE(equations_set_gfem_solution_method)
7845  CALL flagerror("Not implemented.",err,error,*999)
7846  CASE(equations_set_gfv_solution_method)
7847  CALL flagerror("Not implemented.",err,error,*999)
7848  CASE DEFAULT
7849  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
7850  & " is invalid."
7851  CALL flagerror(local_error,err,error,*999)
7852  END SELECT
7853  ENDIF !INDEPENDENT_FIELD_AUTO_CREATED
7854 
7855  CASE DEFAULT
7856  local_error="The third equations set specification of "// &
7857  & trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
7858  & " is invalid for an independent field of a finite elasticity equation."
7859  CALL flagerror(local_error,err,error,*999)
7860  END SELECT
7861  CASE(equations_set_setup_finish_action)
7862  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
7863  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
7864  ! initialize values for active contraction independent field. TODO: actual init for z, trpn, or flag to presolve
7865  IF(equations_set_subtype==equations_set_activecontraction_subtype) THEN
7866  CALL field_number_of_components_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7867  & number_of_components,err,error,*999)
7868  DO component_idx=1,number_of_components
7869  CALL field_component_values_initialise(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7870  & field_values_set_type,component_idx,0.0_dp,err,error,*999)
7871  ENDDO
7872  ENDIF
7873  ENDIF
7874  IF(equations_set%SPECIFICATION(3)==equations_set_monodomain_elasticity_velocity_subtype) THEN
7875  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7876  & field_previous_values_set_type,err,error,*999)
7877  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
7878  & field_previous_values_set_type,err,error,*999)
7879  ENDIF
7880  CASE DEFAULT
7881  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
7882  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
7883  & " is invalid for a finite elasticity equation"
7884  CALL flagerror(local_error,err,error,*999)
7885  END SELECT
7886 
7887  !-----------------------------------------------------------------
7888  ! M a t e r i a l s f i e l d
7889  !-----------------------------------------------------------------
7890  CASE(equations_set_setup_materials_type)
7891  SELECT CASE(equations_set_setup%ACTION_TYPE)
7892  CASE(equations_set_setup_start_action)
7893  equations_materials=>equations_set%MATERIALS
7894  IF(ASSOCIATED(equations_materials)) THEN
7895  number_of_fluid_components=0
7896  SELECT CASE(equations_set_subtype)
7897  CASE(equations_set_mooney_rivlin_subtype,equations_set_no_subtype, &
7898  & equations_set_mooney_rivlin_activecontraction_subtype, &
7899  & equations_set_incompressible_finite_elasticity_darcy_subtype, &
7900  & equations_set_standard_monodomain_elasticity_subtype)
7901  number_of_components=2;
7902  CASE(equations_set_active_strain_subtype)
7903  number_of_components=8;
7904  CASE(equations_set_multiscale_active_strain_subtype)
7905  number_of_components=8;
7906  CASE(equations_set_incompressible_elasticity_driven_darcy_subtype, &
7907  & equations_set_incompressible_elast_multi_comp_darcy_subtype)
7908  number_of_components=3;
7909  CASE(equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_velocity_subtype)
7910  number_of_components=5;
7911  CASE(equations_set_monodomain_elasticity_w_titin_subtype)
7912  number_of_components=6;
7913  CASE(equations_set_1d3d_monodomain_active_strain_subtype)
7914  number_of_components=8;
7915  CASE(equations_set_membrane_subtype)
7916  !\todo Currently the number of components for a membrane problem's material field has been set to 3 in 3D space or
7917  ! 2 in 2D space to work with a Mooney Rivlin material (2 material parameters) and a membrane thickness parameter
7918  ! (only if in 3D space). Extra subtypes will need to be added to use other constitutive relations with
7919  ! membrane mechanics problems.
7920  IF (number_of_dimensions==3) THEN
7921  number_of_components=3
7922  ELSE
7923  number_of_components=2
7924  ENDIF
7925  CASE(equations_set_stvenant_kirchoff_activecontraction_subtype)
7926  number_of_components=2;
7927  CASE(equations_set_isotropic_exponential_subtype)
7928  number_of_components=2;
7929  CASE(equations_set_transverse_isotropic_exponential_subtype)
7930  number_of_components=5;
7931  CASE(equations_set_transverse_isotropic_polynomial_subtype)
7932  number_of_components=4;
7933  CASE(equations_set_transverse_isotropic_active_subtype)
7934  number_of_components=5;
7935  CASE(equations_set_anisotropic_polynomial_subtype)
7936  number_of_components=8;
7937  CASE(equations_set_anisotropic_polynomial_active_subtype)
7938  number_of_components=12;
7939  CASE(equations_set_trans_isotropic_active_transition_subtype)
7940  number_of_components=11;
7941  CASE(equations_set_orthotropic_material_costa_subtype,equations_set_activecontraction_subtype)
7942  number_of_components=7;
7943  CASE(equations_set_compressible_finite_elasticity_subtype,equations_set_compressible_activecontraction_subtype,&
7944  & equations_set_elasticity_darcy_inria_model_subtype)
7945  number_of_components=3;
7946  CASE(equations_set_orthotropic_material_holzapfel_ogden_subtype, &
7947  & equations_set_holzapfel_ogden_activecontraction_subtype)
7948  number_of_components=8;
7949  CASE(equations_set_incompressible_mooney_rivlin_subtype)
7950  number_of_components=2;
7951  CASE(equations_set_nearly_incompressible_mooney_rivlin_subtype)
7952  number_of_components=3;
7953  CASE(equations_set_transverse_isotropic_guccione_subtype, &
7954  & equations_set_guccione_activecontraction_subtype, &
7955  & equations_set_transverse_isotropic_humphrey_yin_subtype)
7956  number_of_components=4;
7957  CASE(equations_set_elasticity_fluid_pressure_static_inria_subtype)
7958  number_of_components=6;
7959  number_of_fluid_components=8
7960  CASE(equations_set_elasticity_fluid_pressure_holmes_mow_subtype)
7961  number_of_components=4
7962  number_of_fluid_components=8
7963  CASE(equations_set_elasticity_fluid_pres_holmes_mow_active_subtype)
7964  number_of_components=6
7965  number_of_fluid_components=8
7966  CASE(equations_set_constitutive_law_in_cellml_evaluate_subtype)
7967  CALL flagerror("Materials field is not required for CellML based constituative laws.",err,error,*999)
7968  CASE(equations_set_constitutive_and_growth_law_in_cellml_subtype)
7969  CALL flagerror("Materials field is not required for CellML based constituative laws.",err,error,*999)
7970  CASE DEFAULT
7971  local_error="The third equations set specification of "// &
7972  & trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
7973  & " is not valid for a finite elasticity type of an elasticity equation set."
7974  CALL flagerror(local_error,err,error,*999)
7975  END SELECT
7976  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
7977  !Create the auto created materials field
7978  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
7979  & materials_field,err,error,*999)
7980  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
7981  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
7982  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
7983  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
7984  & err,error,*999)
7985  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
7986  & geometric_field,err,error,*999)
7987  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7988  & 1,geometric_mesh_component,err,error,*999) ! get 1 = x (?) component
7989 
7990  !U variable type is constitutive law parameters
7991  !V variable type has one component, density
7992  IF(number_of_fluid_components>0) THEN
7993  !If coupled with Darcy pressure equation then a shared material field is used and Darcy material parameters are in U1
7994  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,3,err,error,*999)
7995  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type, &
7996  & field_v_variable_type,field_u1_variable_type],err,error,*999)
7997  ELSE
7998  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,2,err,error,*999)
7999  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type, &
8000  & field_v_variable_type],err,error,*999)
8001  ENDIF
8002  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials",err,error,*999)
8003 
8004  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8005  & field_vector_dimension_type,err,error,*999)
8006  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8007  & field_dp_type,err,error,*999)
8008  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8009  & number_of_components,err,error,*999)
8010  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8011  & field_vector_dimension_type,err,error,*999)
8012  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8013  & field_dp_type,err,error,*999)
8014  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,"Parameters",err,error,*999)
8015 
8016  IF(equations_set_subtype == equations_set_activecontraction_subtype) THEN
8017  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8018  & 1,err,error,*999) ! just 1 component: activation time
8019  CALL field_component_interpolation_set_and_lock(equations_materials%MATERIALS_FIELD, &
8020  & field_v_variable_type,1 ,field_gauss_point_based_interpolation,err,error,*999) ! gauss pt based interp.
8021  ELSE
8022  !Solid density
8023  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8024  & 1,err,error,*999)
8025  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8026  & 1,field_constant_interpolation,err,error,*999)
8027  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8028  & 1,geometric_mesh_component,err,error,*999)
8029  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_v_variable_type,"Density",err,error,*999)
8030  ENDIF
8031 
8032  DO component_idx=1,number_of_components
8033  !Default the materials components to the geometric interpolation setup with constant interpolation
8034  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8035  & component_idx,field_constant_interpolation,err,error,*999)
8036  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8037  & component_idx,geometric_mesh_component,err,error,*999)
8038  ENDDO
8039 
8040  IF(number_of_fluid_components>0) THEN
8041  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u1_variable_type, &
8042  & number_of_fluid_components,err,error,*999)
8043  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u1_variable_type,"Fluid Parameters", &
8044  & err,error,*999)
8045  ENDIF
8046  DO component_idx=1,number_of_fluid_components
8047  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u1_variable_type, &
8048  & component_idx,field_constant_interpolation,err,error,*999)
8049  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u1_variable_type, &
8050  & component_idx,geometric_mesh_component,err,error,*999)
8051  ENDDO
8052 
8053  !Default the field scaling to that of the geometric field
8054  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
8055  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
8056  ELSE
8057  !Check the user specified field
8058  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
8059  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
8060  CALL field_number_of_variables_get(equations_set_setup%FIELD,equations_set_field_number_of_variables,err,error,*999)
8061  SELECT CASE(equations_set_field_number_of_variables)
8062  CASE(1)
8063  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
8064  CASE(2)
8065  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
8066  & field_v_variable_type],err,error,*999)
8067  CASE(3)
8068  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
8069  & field_v_variable_type,field_u1_variable_type],err,error,*999)
8070  CASE DEFAULT
8071  local_error="Invalid number of variables. The number of variables for field number "// &
8072  & trim(number_to_vstring(equations_set_setup%FIELD%USER_NUMBER,"*",err,error))//" is "// &
8073  & trim(number_to_vstring(equations_set_setup%FIELD%NUMBER_OF_VARIABLES,"*",err,error))// &
8074  & " but should be either 1, 2 or 3"
8075  CALL flagerror(local_error,err,error,*999)
8076  END SELECT
8077  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
8078  & err,error,*999)
8079  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
8080  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
8081  & number_of_components,err,error,*999)
8082  IF (equations_set_field_number_of_variables>1) THEN
8083  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
8084  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
8085  & 1,err,error,*999)
8086  ENDIF
8087  IF (equations_set_field_number_of_variables>2) THEN
8088  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
8089  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type, &
8090  & number_of_fluid_components,err,error,*999)
8091  ENDIF
8092  ENDIF
8093  ELSE
8094  CALL flagerror("Equations set materials is not associated.",err,error,*999)
8095  ENDIF
8096  CASE(equations_set_setup_finish_action)
8097  equations_materials=>equations_set%MATERIALS
8098  IF(ASSOCIATED(equations_materials)) THEN
8099  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
8100  !Finish creating the materials field
8101  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
8102  !Set the default values for the materials field
8103  !Don't bother checking equations types, just default to all componets = 1.0
8104  CALL field_number_of_components_get(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8105  & number_of_components,err,error,*999)
8106  DO component_idx=1,number_of_components
8107  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
8108  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
8109  ENDDO
8110  !Initialise density to 0
8111  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
8112  & field_values_set_type,1,0.0_dp,err,error,*999)
8113  ENDIF
8114  ELSE
8115  CALL flagerror("Equations set materials is not associated.",err,error,*999)
8116  ENDIF
8117  CASE DEFAULT
8118  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
8119  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8120  & " is invalid for a finite elasticity equation."
8121  CALL flagerror(local_error,err,error,*999)
8122  END SELECT
8123  CASE(equations_set_setup_source_type)
8124  IF(ASSOCIATED(equations_set%GEOMETRY%GEOMETRIC_FIELD)) THEN
8125  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
8126  & number_of_dimensions,err,error,*999)
8127  number_of_components=number_of_dimensions
8128  ELSE
8129  CALL flagerror("Equations set geometrc field is not associated",err,error,*999)
8130  ENDIF
8131  SELECT CASE(equations_set_setup%ACTION_TYPE)
8132  CASE(equations_set_setup_start_action)
8133  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
8134  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%SOURCE% &
8135  & source_field,err,error,*999)
8136  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
8137  CALL field_label_set(equations_set%SOURCE%SOURCE_FIELD,"Source Field",err,error,*999)
8138  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_independent_type, &
8139  & err,error,*999)
8140  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
8141  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,geometric_decomposition, &
8142  & err,error,*999)
8143  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set%GEOMETRY% &
8144  & geometric_field,err,error,*999)
8145 
8146  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,1,err,error,*999)
8147  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,[field_u_variable_type],err,error,*999)
8148  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8149  & field_vector_dimension_type,err,error,*999)
8150  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8151  & field_dp_type,err,error,*999)
8152  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8153  & number_of_components,err,error,*999)
8154 
8155  CALL field_variable_label_set(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,"Gravity",err,error,*999)
8156  CALL field_component_label_set(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,1,"g1",err,error,*999)
8157  CALL field_component_label_set(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,2,"g2",err,error,*999)
8158  IF(number_of_components==3) THEN
8159  CALL field_component_label_set(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,3,"g3",err,error,*999)
8160  ENDIF
8161 
8162  DO component_idx=1,number_of_components
8163  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
8164  & field_u_variable_type,component_idx,field_constant_interpolation,err,error,*999)
8165  END DO
8166  ELSE
8167  !Check the user specified field
8168  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
8169  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
8170  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
8171  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
8172  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
8173  & err,error,*999)
8174  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
8175  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
8176  & number_of_components,err,error,*999)
8177  ENDIF
8178  CASE(equations_set_setup_finish_action)
8179  IF(ASSOCIATED(equations_set%SOURCE)) THEN
8180  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
8181  !Finish creating the source field
8182  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
8183  !Set the default values for the field
8184  CALL field_number_of_components_get(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8185  & number_of_components,err,error,*999)
8186  DO component_idx=1,number_of_components-1
8187  CALL field_component_values_initialise(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8188  & field_values_set_type,component_idx,0.0_dp,err,error,*999)
8189  ENDDO
8190  CALL field_component_values_initialise(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
8191  & field_values_set_type,number_of_components,-9.80665_dp,err,error,*999)
8192  ENDIF
8193  ELSE
8194  CALL flagerror("Equations set source is not associated.",err,error,*999)
8195  ENDIF
8196  CASE DEFAULT
8197  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
8198  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8199  & " is invalid for a finite elasticity equation."
8200  CALL flagerror(local_error,err,error,*999)
8201  END SELECT
8202  CASE(equations_set_setup_analytic_type)
8203  SELECT CASE(equations_set_setup%ACTION_TYPE)
8204  CASE(equations_set_setup_start_action)
8205  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
8206  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
8207  IF(ASSOCIATED(dependent_field)) THEN
8208  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
8209  IF(ASSOCIATED(geometric_field)) THEN
8210  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
8211  CASE(equations_set_finite_elasticity_cylinder)
8212  IF(equations_set_subtype==equations_set_mooney_rivlin_subtype) THEN
8213  !Create analytic field if required
8214  !Set analtyic function type
8215  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_finite_elasticity_cylinder
8216  ELSE
8217  local_error="The thrid equations set specification of "// &
8218  & trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
8219  & " is invalid. The analytic function type of "// &
8220  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
8221  & " requires that the third equations set specification be a Mooney-Rivlin finite elasticity equation."
8222  CALL flagerror(local_error,err,error,*999)
8223  ENDIF
8224  CASE DEFAULT
8225  local_error="The specified analytic function type of "// &
8226  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
8227  & " is invalid for a finite elasticity equation."
8228  CALL flagerror(local_error,err,error,*999)
8229  END SELECT
8230  ELSE
8231  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
8232  ENDIF
8233  ELSE
8234  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
8235  ENDIF
8236  ELSE
8237  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
8238  ENDIF
8239  CASE(equations_set_setup_finish_action)
8240  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
8241  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
8242  IF(ASSOCIATED(analytic_field)) THEN
8243  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
8244  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
8245  ENDIF
8246  ENDIF
8247  ELSE
8248  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
8249  ENDIF
8250  CASE DEFAULT
8251  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
8252  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8253  & " is invalid for a finite elasticity equation."
8254  CALL flagerror(local_error,err,error,*999)
8255  END SELECT
8256  CASE(equations_set_setup_equations_type)
8257  SELECT CASE(equations_set_setup%ACTION_TYPE)
8258  CASE(equations_set_setup_start_action)
8259  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
8260  !Start the equations creation
8261  CALL equations_create_start(equations_set,equations,err,error,*999)
8262  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
8263  ! sander: Quasistatic / Active contraction. correct location?
8264  IF(equations_set_subtype == equations_set_activecontraction_subtype) THEN
8265  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
8266  ELSE
8267  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
8268  ENDIF
8269  ELSE
8270  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
8271  ENDIF
8272  CASE(equations_set_setup_finish_action)
8273  SELECT CASE(equations_set%SOLUTION_METHOD)
8274  CASE(equations_set_fem_solution_method)
8275  !Finish the equations creation
8276  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
8277  CALL equations_create_finish(equations,err,error,*999)
8278  !Create the equations mapping.
8279  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
8280  SELECT CASE(equations_set_subtype)
8281  CASE(equations_set_elasticity_fluid_pressure_static_inria_subtype, &
8282  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
8283  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype)
8284  !Residual vector also depends on the fluid pressure variable
8285  CALL equationsmapping_residualvariablesnumberset(equations_mapping,2,err,error,*999)
8286  CALL equationsmapping_residualvariabletypesset(equations_mapping, &
8287  & [field_u_variable_type,field_v_variable_type],err,error,*999)
8288  CASE DEFAULT
8289  !Single residual variable
8290  CALL equationsmapping_residualvariabletypesset(equations_mapping,[field_u_variable_type],err,error,*999)
8291  END SELECT
8292  CALL equationsmapping_linearmatricesnumberset(equations_mapping,0,err,error,*999)
8293  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
8294  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
8295  !Create the equations matrices
8296  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
8297  ! set structure and storage types
8298  SELECT CASE(equations%SPARSITY_TYPE)
8299  CASE(equations_matrices_full_matrices)
8300  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
8301  & err,error,*999)
8302  CASE(equations_matrices_sparse_matrices)
8303  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
8304  & matrix_compressed_row_storage_type,err,error,*999)
8305  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
8306  & equations_matrix_fem_structure,err,error,*999)
8307  CASE DEFAULT
8308  local_error="The equations matrices sparsity type of "// &
8309  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
8310  CALL flagerror(local_error,err,error,*999)
8311  END SELECT
8312  !Set Jacobian matrices calculation type to default finite difference.
8313  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_finite_difference_calculated], &
8314  & err,error,*999)
8315  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
8316  CASE(equations_set_bem_solution_method)
8317  CALL flagerror("Not implemented.",err,error,*999)
8318  CASE(equations_set_fd_solution_method)
8319  CALL flagerror("Not implemented.",err,error,*999)
8320  CASE(equations_set_fv_solution_method)
8321  CALL flagerror("Not implemented.",err,error,*999)
8322  CASE(equations_set_gfem_solution_method)
8323  CALL flagerror("Not implemented.",err,error,*999)
8324  CASE(equations_set_gfv_solution_method)
8325  CALL flagerror("Not implemented.",err,error,*999)
8326  CASE DEFAULT
8327  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
8328  & " is invalid."
8329  CALL flagerror(local_error,err,error,*999)
8330  END SELECT
8331  CASE DEFAULT
8332  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
8333  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8334  & " is invalid for a finite elasticity equation."
8335  CALL flagerror(local_error,err,error,*999)
8336  END SELECT
8337  CASE(equations_set_setup_derived_type)
8338  ! We want to be able to set which derived variables are calculated before finishing the derived
8339  ! field, so don't create field variables or check the provided field until the finish action.
8340  SELECT CASE(equations_set_setup%ACTION_TYPE)
8341  CASE(equations_set_setup_start_action)
8342  IF(equations_set%derived%derivedFieldAutoCreated) THEN
8343  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%derived% &
8344  & derivedfield,err,error,*999)
8345  CALL field_type_set_and_lock(equations_set%derived%derivedField,field_general_type,err,error,*999)
8346  CALL field_label_set(equations_set%derived%derivedField,"Derived Field",err,error,*999)
8347  CALL field_dependent_type_set_and_lock(equations_set%derived%derivedField,field_dependent_type, &
8348  & err,error,*999)
8349  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
8350  CALL field_mesh_decomposition_set_and_lock(equations_set%derived%derivedField,geometric_decomposition, &
8351  & err,error,*999)
8352  CALL field_geometric_field_set_and_lock(equations_set%derived%derivedField,equations_set%GEOMETRY% &
8353  & geometric_field,err,error,*999)
8354  END IF
8355  CASE(equations_set_setup_finish_action)
8356  IF(ASSOCIATED(equations_set%derived)) THEN
8357  ALLOCATE(variable_types(equations_set%derived%numberOfVariables),stat=err)
8358  IF(err/=0) CALL flagerror("Could not allocate derived field variable types.",err,error,*999)
8359  varidx=0
8360  DO derivedidx=1,equations_set_number_of_derived_types
8361  IF(equations_set%derived%variableTypes(derivedidx)/=0) THEN
8362  varidx=varidx+1
8363  variable_types(varidx)=equations_set%derived%variableTypes(derivedidx)
8364  END IF
8365  END DO
8366  IF(equations_set%derived%derivedFieldAutoCreated) THEN
8367  CALL field_number_of_variables_set_and_lock(equations_set%derived%derivedField, &
8368  & equations_set%derived%numberOfVariables,err,error,*999)
8369  CALL field_variable_types_set_and_lock(equations_set%derived%derivedField,variable_types,err,error,*999)
8370  DO derivedidx=1,equations_set_number_of_derived_types
8371  variabletype=equations_set%derived%variableTypes(derivedidx)
8372  IF(variabletype/=0) THEN
8373  CALL field_data_type_set_and_lock(equations_set%derived%derivedField,variabletype, &
8374  & field_dp_type,err,error,*999)
8375  SELECT CASE(derivedidx)
8376  CASE(equations_set_derived_strain)
8377  CALL field_dimension_set_and_lock(equations_set%derived%derivedField,variabletype, &
8378  & field_vector_dimension_type,err,error,*999)
8379  CALL field_variable_label_set(equations_set%derived%derivedField,variabletype,"Strain",err,error,*999)
8380  CALL field_number_of_components_set_and_lock(equations_set%derived%derivedField,variabletype, &
8381  & 6,err,error,*999)
8382  CASE(equations_set_derived_stress)
8383  CALL field_dimension_set_and_lock(equations_set%derived%derivedField,variabletype, &
8384  & field_vector_dimension_type,err,error,*999)
8385  CALL field_variable_label_set(equations_set%derived%derivedField,variabletype,"Stress",err,error,*999)
8386  CALL field_number_of_components_set_and_lock(equations_set%derived%derivedField,variabletype, &
8387  & 6,err,error,*999)
8388  CASE DEFAULT
8389  CALL flagerror("The specified derived field type of "//trim(number_to_vstring(derivedidx,"*",err,error))// &
8390  & " is not supported for a finite elasticity equations set type.",err,error,*999)
8391  END SELECT
8392  END IF
8393  END DO
8394  !Finish creating the derived field
8395  CALL field_create_finish(equations_set%derived%derivedField,err,error,*999)
8396  ELSE
8397  !Check the user specified derived field
8398  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
8399  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
8400  CALL field_number_of_variables_check(equations_set_setup%FIELD, &
8401  & equations_set%derived%numberOfVariables,err,error,*999)
8402  CALL field_variable_types_check(equations_set_setup%FIELD,variable_types,err,error,*999)
8403 
8404  DO derivedidx=1,equations_set_number_of_derived_types
8405  variabletype=equations_set%derived%variableTypes(derivedidx)
8406  IF(variabletype/=0) THEN
8407  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
8408  SELECT CASE(derivedidx)
8409  CASE(equations_set_derived_strain)
8410  CALL field_dimension_check(equations_set%derived%derivedField,variabletype, &
8411  & field_vector_dimension_type,err,error,*999)
8412  CALL field_number_of_components_check(equations_set%derived%derivedField,variabletype, &
8413  & 6,err,error,*999)
8414  CASE(equations_set_derived_stress)
8415  CALL field_dimension_check(equations_set%derived%derivedField,variabletype, &
8416  & field_vector_dimension_type,err,error,*999)
8417  CALL field_number_of_components_check(equations_set%derived%derivedField,variabletype, &
8418  & 6,err,error,*999)
8419  CASE DEFAULT
8420  CALL flagerror("The specified derived field type of "//trim(number_to_vstring(derivedidx,"*",err,error))// &
8421  & " is not supported for a finite elasticity equations set type.",err,error,*999)
8422  END SELECT
8423  END IF
8424  END DO
8425  END IF
8426  ELSE
8427  CALL flagerror("Equations set derived is not associated.",err,error,*999)
8428  ENDIF
8429  CASE DEFAULT
8430  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
8431  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8432  & " is invalid for a finite elasticity equation."
8433  CALL flagerror(local_error,err,error,*999)
8434  END SELECT
8435  CASE DEFAULT
8436  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
8437  & " is invalid for a finite elasticity equation."
8438  CALL flagerror(local_error,err,error,*999)
8439  END SELECT
8440  CASE DEFAULT
8441  local_error="The third equations set specification of "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
8442  & " is not valid for a finite elasticity type of an elasticity equation set."
8443  CALL flagerror(local_error,err,error,*999)
8444  END SELECT
8445  ELSE
8446  CALL flagerror("Equations set is not associated.",err,error,*999)
8447  ENDIF
8448 
8449  exits("FINITE_ELASTICITY_EQUATIONS_SET_SETUP")
8450  RETURN
8451 999 errorsexits("FINITE_ELASTICITY_EQUATIONS_SET_SETUP",err,error)
8452  RETURN 1
8453  END SUBROUTINE finite_elasticity_equations_set_setup
8454 
8455  !
8456  !================================================================================================================================
8457  !
8458 
8460  SUBROUTINE finiteelasticity_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
8461 
8462  !Argument variables
8463  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
8464  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
8465  INTEGER(INTG), INTENT(OUT) :: ERR
8466  TYPE(varying_string), INTENT(OUT) :: ERROR
8467  !Local Variables
8468  TYPE(varying_string) :: LOCAL_ERROR
8469 
8470  enters("FiniteElasticity_EquationsSetSolutionMethodSet",err,error,*999)
8471 
8472  IF(ASSOCIATED(equations_set)) THEN
8473  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
8474  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
8475  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
8476  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
8477  & err,error,*999)
8478  END IF
8479  SELECT CASE(equations_set%SPECIFICATION(3))
8480  CASE(equations_set_membrane_subtype,equations_set_mooney_rivlin_subtype, &
8481  & equations_set_mooney_rivlin_activecontraction_subtype, &
8482  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
8483  & equations_set_isotropic_exponential_subtype,equations_set_transverse_isotropic_active_subtype, &
8484  & equations_set_trans_isotropic_active_transition_subtype, &
8485  & equations_set_transverse_isotropic_exponential_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
8486  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
8487  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype, &
8488  & equations_set_compressible_activecontraction_subtype, &
8489  & equations_set_activecontraction_subtype,equations_set_no_subtype, &
8490  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
8491  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
8492  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
8493  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
8494  & equations_set_incompressible_elast_multi_comp_darcy_subtype,equations_set_transverse_isotropic_guccione_subtype, &
8495  & equations_set_constitutive_law_in_cellml_evaluate_subtype, &
8496  & equations_set_constitutive_and_growth_law_in_cellml_subtype, &
8497  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
8498  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
8499  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
8500  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
8501  & equations_set_standard_monodomain_elasticity_subtype, &
8502  & equations_set_1d3d_monodomain_elasticity_subtype, &
8503  & equations_set_monodomain_elasticity_w_titin_subtype, &
8504  & equations_set_monodomain_elasticity_velocity_subtype, &
8505  & equations_set_holzapfel_ogden_activecontraction_subtype, &
8506  & equations_set_active_strain_subtype, &
8507  & equations_set_multiscale_active_strain_subtype, &
8508  & equations_set_1d3d_monodomain_active_strain_subtype, &
8509  & equations_set_guccione_activecontraction_subtype)
8510  SELECT CASE(solution_method)
8511  CASE(equations_set_fem_solution_method)
8512  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
8513  CASE(equations_set_bem_solution_method)
8514  CALL flagerror("Not implemented.",err,error,*999)
8515  CASE(equations_set_fd_solution_method)
8516  CALL flagerror("Not implemented.",err,error,*999)
8517  CASE(equations_set_fv_solution_method)
8518  CALL flagerror("Not implemented.",err,error,*999)
8519  CASE(equations_set_gfem_solution_method)
8520  CALL flagerror("Not implemented.",err,error,*999)
8521  CASE(equations_set_gfv_solution_method)
8522  CALL flagerror("Not implemented.",err,error,*999)
8523  CASE DEFAULT
8524  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
8525  CALL flagerror(local_error,err,error,*999)
8526  END SELECT
8527  CASE DEFAULT
8528  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
8529  & " is not valid for a finite elasticity equation type of an elasticity equations set class."
8530  CALL flagerror(local_error,err,error,*999)
8531  END SELECT
8532  ELSE
8533  CALL flagerror("Equations set is not associated.",err,error,*999)
8534  ENDIF
8535 
8536  exits("FiniteElasticity_EquationsSetSolutionMethodSet")
8537  RETURN
8538 999 errors("FiniteElasticity_EquationsSetSolutionMethodSet",err,error)
8539  exits("FiniteElasticity_EquationsSetSolutionMethodSet")
8540  RETURN 1
8541 
8542  END SUBROUTINE finiteelasticity_equationssetsolutionmethodset
8543 
8544  !
8545  !================================================================================================================================
8546  !
8547 
8549  SUBROUTINE finiteelasticity_equationssetspecificationset(equationsSet,specification,err,error,*)
8550 
8551  !Argument variables
8552  TYPE(equations_set_type), POINTER :: equationsSet
8553  INTEGER(INTG), INTENT(IN) :: specification(:)
8554  INTEGER(INTG), INTENT(OUT) :: err
8555  TYPE(varying_string), INTENT(OUT) :: error
8556  !Local Variables
8557  TYPE(varying_string) :: localError
8558  INTEGER(INTG) :: subtype
8559 
8560  enters("FiniteElasticity_EquationsSetSpecificationSet",err,error,*999)
8561 
8562  IF(ASSOCIATED(equationsset)) THEN
8563  IF(SIZE(specification,1)/=3) THEN
8564  CALL flagerror("Equations set specification must have three entries for a finite elasticity type equations set.", &
8565  & err,error,*999)
8566  END IF
8567  subtype=specification(3)
8568  SELECT CASE(subtype)
8569  CASE(equations_set_membrane_subtype,equations_set_mooney_rivlin_subtype, &
8570  & equations_set_mooney_rivlin_activecontraction_subtype, &
8571  & equations_set_stvenant_kirchoff_activecontraction_subtype, &
8572  & equations_set_isotropic_exponential_subtype,equations_set_transverse_isotropic_active_subtype, &
8573  & equations_set_trans_isotropic_active_transition_subtype, &
8574  & equations_set_transverse_isotropic_exponential_subtype,equations_set_transverse_isotropic_polynomial_subtype, &
8575  & equations_set_anisotropic_polynomial_subtype,equations_set_anisotropic_polynomial_active_subtype, &
8576  & equations_set_orthotropic_material_costa_subtype,equations_set_compressible_finite_elasticity_subtype, &
8577  & equations_set_compressible_activecontraction_subtype, &
8578  & equations_set_activecontraction_subtype, equations_set_no_subtype, &
8579  & equations_set_incompressible_finite_elasticity_darcy_subtype,equations_set_elasticity_darcy_inria_model_subtype, &
8580  & equations_set_incompressible_elasticity_driven_darcy_subtype, &
8581  & equations_set_orthotropic_material_holzapfel_ogden_subtype, &
8582  & equations_set_incompressible_mooney_rivlin_subtype,equations_set_nearly_incompressible_mooney_rivlin_subtype, &
8583  & equations_set_incompressible_elast_multi_comp_darcy_subtype,equations_set_transverse_isotropic_guccione_subtype, &
8584  & equations_set_guccione_activecontraction_subtype, &
8585  & equations_set_constitutive_law_in_cellml_evaluate_subtype, &
8586  & equations_set_constitutive_and_growth_law_in_cellml_subtype, &
8587  & equations_set_elasticity_fluid_pressure_static_inria_subtype, &
8588  & equations_set_elasticity_fluid_pressure_holmes_mow_subtype, &
8589  & equations_set_elasticity_fluid_pres_holmes_mow_active_subtype, &
8590  & equations_set_transverse_isotropic_humphrey_yin_subtype, &
8591  & equations_set_standard_monodomain_elasticity_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
8592  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_active_strain_subtype, &
8593  & equations_set_multiscale_active_strain_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
8594  & equations_set_1d3d_monodomain_active_strain_subtype, &
8595  & equations_set_holzapfel_ogden_activecontraction_subtype)
8596  !Set full specification
8597  IF(ALLOCATED(equationsset%specification)) THEN
8598  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
8599  ELSE
8600  ALLOCATE(equationsset%specification(3),stat=err)
8601  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
8602  END IF
8603  equationsset%specification(1:3)=[equations_set_elasticity_class,equations_set_finite_elasticity_type,subtype]
8604  CASE DEFAULT
8605  localerror="Equations set subtype "//trim(numbertovstring(subtype,"*",err,error))// &
8606  & " is not valid for a finite elasticity equation type of an elasticity equations set class."
8607  CALL flagerror(localerror,err,error,*999)
8608  END SELECT
8609  ELSE
8610  CALL flagerror("Equations set is not associated.",err,error,*999)
8611  END IF
8612 
8613  exits("FiniteElasticity_EquationsSetSpecificationSet")
8614  RETURN
8615 999 errors("FiniteElasticity_EquationsSetSpecificationSet",err,error)
8616  exits("FiniteElasticity_EquationsSetSpecificationSet")
8617  RETURN 1
8618 
8619  END SUBROUTINE finiteelasticity_equationssetspecificationset
8620 
8621  !
8622  !================================================================================================================================
8623  !
8624 
8626  SUBROUTINE finite_elasticity_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
8627 
8628  !Argument variables
8629  TYPE(problem_type), POINTER :: PROBLEM
8630  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
8631  INTEGER(INTG), INTENT(OUT) :: ERR
8632  TYPE(varying_string), INTENT(OUT) :: ERROR
8633  !Local Variables
8634  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
8635  TYPE(solver_type), POINTER :: SOLVER
8636  TYPE(solver_type), POINTER :: CELLML_SOLVER
8637  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
8638  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
8639  TYPE(solvers_type), POINTER :: SOLVERS
8640  TYPE(varying_string) :: LOCAL_ERROR
8641  INTEGER(INTG) :: PROBLEM_SUBTYPE
8642 
8643  enters("FINITE_ELASTICITY_PROBLEM_SETUP",err,error,*999)
8644 
8645  NULLIFY(control_loop)
8646  NULLIFY(solver)
8647  NULLIFY(cellml_solver)
8648  NULLIFY(solver_equations)
8649  NULLIFY(solvers)
8650  NULLIFY(cellml_equations)
8651 
8652  IF(ASSOCIATED(problem)) THEN
8653  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
8654  CALL flagerror("Problem specification is not allocated.",err,error,*999)
8655  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
8656  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
8657  ENDIF
8658  problem_subtype=problem%SPECIFICATION(3)
8659  SELECT CASE(problem_subtype)
8660  CASE(problem_no_subtype,problem_quasistatic_finite_elasticity_subtype, &
8661  & problem_finite_elasticity_cellml_subtype, &
8662  & problem_finite_elasticity_with_growth_cellml_subtype, &
8663  & problem_multiscale_finite_elasticity_subtype)
8664  SELECT CASE(problem_setup%SETUP_TYPE)
8665  CASE(problem_setup_initial_type)
8666  SELECT CASE(problem_setup%ACTION_TYPE)
8667  CASE(problem_setup_start_action)
8668  !Do nothing????
8669  CASE(problem_setup_finish_action)
8670  !Do nothing????
8671  CASE DEFAULT
8672  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
8673  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8674  & " is invalid for a finite elasticity problem."
8675  CALL flagerror(local_error,err,error,*999)
8676  END SELECT
8677  CASE(problem_setup_control_type)
8678  SELECT CASE(problem_setup%ACTION_TYPE)
8679  CASE(problem_setup_start_action)
8680  !Set up a simple control loop: default is load increment type now
8681  CALL control_loop_create_start(problem,control_loop,err,error,*999)
8682  CALL control_loop_type_set(control_loop,problem_control_load_increment_loop_type,err,error,*999)
8683  ! sander - Quasistatic: Change 1/2. worth splitting entire case over in copy/paste?
8684  IF(problem_subtype==problem_quasistatic_finite_elasticity_subtype.OR. &
8685  problem_subtype==problem_finite_elasticity_with_growth_cellml_subtype) THEN
8686  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
8687  ENDIF
8688  CASE(problem_setup_finish_action)
8689  !Finish the control loops
8690  control_loop_root=>problem%CONTROL_LOOP
8691  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8692  CALL control_loop_create_finish(control_loop,err,error,*999)
8693  CASE DEFAULT
8694  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
8695  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8696  & " is invalid for a finite elasticity problem."
8697  CALL flagerror(local_error,err,error,*999)
8698  END SELECT
8699  CASE(problem_setup_solvers_type)
8700  !Get the control loop
8701  control_loop_root=>problem%CONTROL_LOOP
8702  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8703  SELECT CASE(problem_setup%ACTION_TYPE)
8704  CASE(problem_setup_start_action)
8705  !Start the solvers creation
8706  CALL solvers_create_start(control_loop,solvers,err,error,*999)
8707  SELECT CASE(problem_subtype)
8708  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
8709  CALL solvers_number_set(solvers,2,err,error,*999)
8710  !Set the first solver to be an ODE integrator
8711  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8712  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
8713  !Set solver defaults
8714  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
8715  !Set the second solver to be a nonlinear solver
8716  NULLIFY(solver)
8717  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8718  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
8719  !Set solver defaults
8720  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
8721  !Create the CellML evaluator solver
8722  NULLIFY(cellml_solver)
8723  CALL solver_newton_cellml_evaluator_create(solver,cellml_solver,err,error,*999)
8724  !Link the CellML evaluator solver to the solver
8725  CALL solver_linked_solver_add(solver,cellml_solver,solver_cellml_evaluator_type,err,error,*999)
8726  CASE(problem_no_subtype,problem_quasistatic_finite_elasticity_subtype)
8727  CALL solvers_number_set(solvers,1,err,error,*999)
8728  !Set the solver to be a nonlinear solver
8729  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8730  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
8731  !Set solver defaults
8732  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
8733  CASE(problem_finite_elasticity_cellml_subtype)
8734  CALL solvers_number_set(solvers,1,err,error,*999)
8735  !Set the solver to be a nonlinear solver
8736  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8737  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
8738  !Set solver defaults
8739  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
8740  !Create the CellML evaluator solver
8741  CALL solver_newton_cellml_evaluator_create(solver,cellml_solver,err,error,*999)
8742  !Link the CellML evaluator solver to the solver
8743  CALL solver_linked_solver_add(solver,cellml_solver,solver_cellml_evaluator_type,err,error,*999)
8744  CASE(problem_multiscale_finite_elasticity_subtype)
8745  CALL solvers_number_set(solvers,2,err,error,*999)
8746  !Set the first solver to be a DAE solver
8747  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8748  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
8749  CALL solver_label_set(solver,"ODE_Solver",err,error,*999)
8750  !Set solver defaults
8751  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
8752  NULLIFY(solver)
8753  !Set the second solver to be a nonlinear solver
8754  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8755  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
8756  CALL solver_label_set(solver,"Nonlinear_Solver",err,error,*999)
8757  !Set solver defaults
8758  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
8759  CASE DEFAULT
8760  local_error="The third problem specification of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8761  & " is not valid for a finite elasticity type of an elasticity problem."
8762  CALL flagerror(local_error,err,error,*999)
8763 ! CALL SOLVERS_NUMBER_SET(SOLVERS,1,ERR,ERROR,*999)
8764 ! !Set the solver to be a nonlinear solver
8765 ! CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,ERR,ERROR,*999)
8766 ! CALL SOLVER_TYPE_SET(SOLVER,SOLVER_NONLINEAR_TYPE,ERR,ERROR,*999)
8767 ! !Set solver defaults
8768 ! CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,ERR,ERROR,*999)
8769  END SELECT
8770  CASE(problem_setup_finish_action)
8771  !Get the solvers
8772  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
8773  !Finish the solvers creation
8774  CALL solvers_create_finish(solvers,err,error,*999)
8775  CASE DEFAULT
8776  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
8777  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8778  & " is invalid for a finite elasticity problem."
8779  CALL flagerror(local_error,err,error,*999)
8780  END SELECT
8781  CASE(problem_setup_solver_equations_type)
8782  SELECT CASE(problem_setup%ACTION_TYPE)
8783  CASE(problem_setup_start_action)
8784  !Get the control loop
8785  control_loop_root=>problem%CONTROL_LOOP
8786  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8787  !Get the solver
8788  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
8789  SELECT CASE(problem_subtype)
8790  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
8791  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8792  !Create the solver equatgions
8793  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
8794  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
8795  ! sander - Quasistatic: Change 2/2. worth splitting entire case over in copy/paste?
8796  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
8797  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
8798  CASE(problem_no_subtype,problem_finite_elasticity_cellml_subtype)
8799  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8800  !Create the solver equations
8801  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
8802  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
8803  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
8804  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
8805  CASE(problem_quasistatic_finite_elasticity_subtype)
8806  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8807  !Create the solver equations
8808  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
8809  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
8810  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
8811  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
8812  CASE(problem_multiscale_finite_elasticity_subtype)
8813  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8814  !Create the solver equations
8815  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
8816  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
8817  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
8818  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
8819  CASE DEFAULT
8820  local_error="The third problem specification of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8821  & " is not valid for a finite elasticity type of an elasticity problem."
8822  CALL flagerror(local_error,err,error,*999)
8823  END SELECT
8824  CASE(problem_setup_finish_action)
8825  !Get the control loop
8826  control_loop_root=>problem%CONTROL_LOOP
8827  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8828  !Get the solver equations
8829  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
8830  SELECT CASE(problem_subtype)
8831  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
8832  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8833  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
8834  !Finish the solver equations creation
8835  CALL solver_equations_create_finish(solver_equations,err,error,*999)
8836  CASE(problem_no_subtype,problem_finite_elasticity_cellml_subtype,problem_quasistatic_finite_elasticity_subtype)
8837  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8838  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
8839  !Finish the solver equations creation
8840  CALL solver_equations_create_finish(solver_equations,err,error,*999)
8841  CASE(problem_multiscale_finite_elasticity_subtype)
8842  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8843  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
8844  !Finish the solver equations creation
8845  CALL solver_equations_create_finish(solver_equations,err,error,*999)
8846  CASE DEFAULT
8847  local_error="The third problem specification of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8848  & " is not valid for a finite elasticity type of an elasticity problem."
8849  CALL flagerror(local_error,err,error,*999)
8850  END SELECT
8851  CASE DEFAULT
8852  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
8853  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8854  & " is invalid for a finite elasticity problem."
8855  CALL flagerror(local_error,err,error,*999)
8856  END SELECT
8857  CASE(problem_setup_cellml_equations_type)
8858  SELECT CASE(problem_setup%ACTION_TYPE)
8859  CASE(problem_setup_start_action)
8860  !Get the control loop
8861  control_loop_root=>problem%CONTROL_LOOP
8862  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8863  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
8864  SELECT CASE(problem_subtype)
8865  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
8866  !Get the CellML integrator solver
8867  CALL solvers_solver_get(solvers,1,cellml_solver,err,error,*999)
8868  CALL cellml_equations_create_start(cellml_solver,cellml_equations,err,error,*999)
8869  NULLIFY(cellml_solver)
8870  NULLIFY(cellml_equations)
8871  !Get the nonlinear solver
8872  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8873  !Get the CellML evaluator solver
8874  CALL solver_newton_cellml_solver_get(solver,cellml_solver,err,error,*999)
8875  !Create the CellML equations
8876  CALL cellml_equations_create_start(cellml_solver,cellml_equations, &
8877  & err,error,*999)
8878  CASE(problem_finite_elasticity_cellml_subtype)
8879  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8880  !Get the CellML evaluator solver
8881  CALL solver_newton_cellml_solver_get(solver,cellml_solver,err,error,*999)
8882  !Create the CellML equations
8883  CALL cellml_equations_create_start(cellml_solver,cellml_equations, &
8884  & err,error,*999)
8885  CASE(problem_multiscale_finite_elasticity_subtype)
8886  !Create the CellML equations for the first DAE solver
8887  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8888  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
8889  CASE DEFAULT
8890  local_error="The third problem specification of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8891  & " is not valid for a finite elasticity type of an elasticity problem."
8892  CALL flagerror(local_error,err,error,*999)
8893  END SELECT
8894  CASE(problem_setup_finish_action)
8895  !Get the control loop
8896  control_loop_root=>problem%CONTROL_LOOP
8897  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
8898  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
8899  SELECT CASE(problem_subtype)
8900  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
8901  !Get the CellML integrator solver
8902  CALL solvers_solver_get(solvers,1,cellml_solver,err,error,*999)
8903  !Get the CellML equations for the CellML evaluator solver
8904  CALL solver_cellml_equations_get(cellml_solver,cellml_equations,err,error,*999)
8905  !Finish the CellML equations creation
8906  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
8907  NULLIFY(cellml_solver)
8908  NULLIFY(cellml_equations)
8909  !Get the nonlinear solver
8910  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
8911  !Get the CellML evaluator solver
8912  CALL solver_newton_cellml_solver_get(solver,cellml_solver,err,error,*999)
8913  !Get the CellML equations for the CellML evaluator solver
8914  CALL solver_cellml_equations_get(cellml_solver,cellml_equations,err,error,*999)
8915  !Finish the CellML equations creation
8916  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
8917  CASE(problem_finite_elasticity_cellml_subtype)
8918  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8919  !Get the CellML evaluator solver
8920  CALL solver_newton_cellml_solver_get(solver,cellml_solver,err,error,*999)
8921  !Get the CellML equations for the CellML evaluator solver
8922  CALL solver_cellml_equations_get(cellml_solver,cellml_equations,err,error,*999)
8923  !Finish the CellML equations creation
8924  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
8925  CASE(problem_multiscale_finite_elasticity_subtype)
8926  !Get the CellML equations for the first DAE solver
8927  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
8928  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
8929  !Finish the CellML equations creation
8930  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
8931  CASE DEFAULT
8932  local_error="The third problem specification of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8933  & " is not valid for a finite elasticity type of an elasticity problem."
8934  CALL flagerror(local_error,err,error,*999)
8935  END SELECT
8936  CASE DEFAULT
8937  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
8938  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8939  & " is invalid for a finite elasticity equation."
8940  CALL flagerror(local_error,err,error,*999)
8941  END SELECT
8942  CASE DEFAULT
8943  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
8944  & " is invalid for a finite elasticity problem."
8945  CALL flagerror(local_error,err,error,*999)
8946  END SELECT
8947  CASE DEFAULT
8948  local_error="Problem subtype "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
8949  & " is not valid for a finite elasticity type of an elasticity problem class."
8950  CALL flagerror(local_error,err,error,*999)
8951  END SELECT
8952  ELSE
8953  CALL flagerror("Problem is not associated.",err,error,*999)
8954  ENDIF
8955 
8956  exits("FINITE_ELASTICITY_PROBLEM_SETUP")
8957  RETURN
8958 999 errorsexits("FINITE_ELASTICITY_PROBLEM_SETUP",err,error)
8959  RETURN 1
8960  END SUBROUTINE finite_elasticity_problem_setup
8961 
8962  !
8963  !================================================================================================================================
8964  !
8965 
8967  SUBROUTINE finiteelasticity_contactproblemsetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
8968 
8969  !Argument variables
8970  TYPE(problem_type), POINTER :: PROBLEM
8971  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
8972  INTEGER(INTG), INTENT(OUT) :: ERR
8973  TYPE(varying_string), INTENT(OUT) :: ERROR
8974  !Local Variables
8975  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
8976  TYPE(solver_type), POINTER :: nonlinearSolver,transformationSolver
8977  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
8978  TYPE(solvers_type), POINTER :: SOLVERS
8979  TYPE(varying_string) :: LOCAL_ERROR
8980  INTEGER(INTG) :: PROBLEM_SUBTYPE
8981 
8982  enters("FINITE_ELASTICITY_PROBLEM_SETUP",err,error,*999)
8983 
8984  NULLIFY(control_loop)
8985  NULLIFY(nonlinearsolver)
8986  NULLIFY(transformationsolver)
8987  NULLIFY(solver_equations)
8988  NULLIFY(solvers)
8989 
8990  IF(ASSOCIATED(problem)) THEN
8991  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
8992  CALL flagerror("Problem specification is not allocated.",err,error,*999)
8993  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
8994  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
8995  END IF
8996  problem_subtype=problem%SPECIFICATION(3)
8997  SELECT CASE(problem_subtype)
8998  CASE(problem_fe_contact_transform_reproject_subtype,problem_fe_contact_transform_subtype)
8999  SELECT CASE(problem_setup%SETUP_TYPE)
9000  CASE(problem_setup_initial_type)
9001  SELECT CASE(problem_setup%ACTION_TYPE)
9002  CASE(problem_setup_start_action)
9003  !Do nothing????
9004  CASE(problem_setup_finish_action)
9005  !Do nothing????
9006  CASE DEFAULT
9007  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9008  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9009  & " is invalid for a finite elasticity problem."
9010  CALL flagerror(local_error,err,error,*999)
9011  END SELECT
9012  CASE(problem_setup_control_type)
9013  SELECT CASE(problem_setup%ACTION_TYPE)
9014  CASE(problem_setup_start_action)
9015  !Set up a simple control loop: default is load increment type now
9016  CALL control_loop_create_start(problem,control_loop,err,error,*999)
9017  CALL control_loop_type_set(control_loop,problem_control_load_increment_loop_type,err,error,*999)
9018  CASE(problem_setup_finish_action)
9019  !Finish the control loops
9020  control_loop_root=>problem%CONTROL_LOOP
9021  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9022  CALL control_loop_create_finish(control_loop,err,error,*999)
9023  CASE DEFAULT
9024  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9025  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9026  & " is invalid for a finite elasticity problem."
9027  CALL flagerror(local_error,err,error,*999)
9028  END SELECT
9029  CASE(problem_setup_solvers_type)
9030  !Get the control loop
9031  control_loop_root=>problem%CONTROL_LOOP
9032  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9033  SELECT CASE(problem_setup%ACTION_TYPE)
9034  CASE(problem_setup_start_action)
9035  !Start the solvers creation
9036  CALL solvers_create_start(control_loop,solvers,err,error,*999)
9037  CALL solvers_number_set(solvers,2,err,error,*999)
9038  !Set the first solver to be a geometric transformation solver
9039  CALL solvers_solver_get(solvers,1,transformationsolver,err,error,*999)
9040  CALL solver_type_set(transformationsolver,solver_geometric_transformation_type,err,error,*999)
9041  !Set the second solver to be a nonlinear solver
9042  CALL solvers_solver_get(solvers,2,nonlinearsolver,err,error,*999)
9043  CALL solver_type_set(nonlinearsolver,solver_nonlinear_type,err,error,*999)
9044  !Set solver defaults
9045  CALL solver_library_type_set(nonlinearsolver,solver_petsc_library,err,error,*999)
9046  CASE(problem_setup_finish_action)
9047  !Get the solvers
9048  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9049  !Finish the solvers creation
9050  CALL solvers_create_finish(solvers,err,error,*999)
9051  CASE DEFAULT
9052  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9053  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9054  & " is invalid for a finite elasticity problem."
9055  CALL flagerror(local_error,err,error,*999)
9056  END SELECT
9057  CASE(problem_setup_solver_equations_type)
9058  SELECT CASE(problem_setup%ACTION_TYPE)
9059  CASE(problem_setup_start_action)
9060  !Get the control loop
9061  control_loop_root=>problem%CONTROL_LOOP
9062  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9063  !Get the solver
9064  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9065  CALL solvers_solver_get(solvers,2,nonlinearsolver,err,error,*999)
9066  !Create the solver equatgions
9067  CALL solver_equations_create_start(nonlinearsolver,solver_equations,err,error,*999)
9068  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
9069  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
9070  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
9071  CASE(problem_setup_finish_action)
9072  !Get the control loop
9073  control_loop_root=>problem%CONTROL_LOOP
9074  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9075  !Get the solver equations
9076  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9077  CALL solvers_solver_get(solvers,2,nonlinearsolver,err,error,*999)
9078  CALL solver_solver_equations_get(nonlinearsolver,solver_equations,err,error,*999)
9079  !Finish the solver equations creation
9080  CALL solver_equations_create_finish(solver_equations,err,error,*999)
9081  CASE DEFAULT
9082  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9083  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9084  & " is invalid for a finite elasticity problem."
9085  CALL flagerror(local_error,err,error,*999)
9086  END SELECT
9087  CASE DEFAULT
9088  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9089  & " is invalid for a finite elasticity problem."
9090  CALL flagerror(local_error,err,error,*999)
9091  END SELECT
9092  CASE(problem_fe_contact_reproject_subtype)
9093  SELECT CASE(problem_setup%SETUP_TYPE)
9094  CASE(problem_setup_initial_type)
9095  SELECT CASE(problem_setup%ACTION_TYPE)
9096  CASE(problem_setup_start_action)
9097  !Do nothing????
9098  CASE(problem_setup_finish_action)
9099  !Do nothing????
9100  CASE DEFAULT
9101  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9102  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9103  & " is invalid for a finite elasticity problem."
9104  CALL flagerror(local_error,err,error,*999)
9105  END SELECT
9106  CASE(problem_setup_control_type)
9107  SELECT CASE(problem_setup%ACTION_TYPE)
9108  CASE(problem_setup_start_action)
9109  !Set up a simple control loop: default is load increment type now
9110  CALL control_loop_create_start(problem,control_loop,err,error,*999)
9111  CALL control_loop_type_set(control_loop,problem_control_load_increment_loop_type,err,error,*999)
9112  CASE(problem_setup_finish_action)
9113  !Finish the control loops
9114  control_loop_root=>problem%CONTROL_LOOP
9115  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9116  CALL control_loop_create_finish(control_loop,err,error,*999)
9117  CASE DEFAULT
9118  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9119  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9120  & " is invalid for a finite elasticity problem."
9121  CALL flagerror(local_error,err,error,*999)
9122  END SELECT
9123  CASE(problem_setup_solvers_type)
9124  !Get the control loop
9125  control_loop_root=>problem%CONTROL_LOOP
9126  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9127  SELECT CASE(problem_setup%ACTION_TYPE)
9128  CASE(problem_setup_start_action)
9129  !Start the solvers creation
9130  CALL solvers_create_start(control_loop,solvers,err,error,*999)
9131  CALL solvers_number_set(solvers,1,err,error,*999)
9132  !Set the solver to be a nonlinear solver
9133  CALL solvers_solver_get(solvers,1,nonlinearsolver,err,error,*999)
9134  CALL solver_type_set(nonlinearsolver,solver_nonlinear_type,err,error,*999)
9135  !Set solver defaults
9136  CALL solver_library_type_set(nonlinearsolver,solver_petsc_library,err,error,*999)
9137  CASE(problem_setup_finish_action)
9138  !Get the solvers
9139  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9140  !Finish the solvers creation
9141  CALL solvers_create_finish(solvers,err,error,*999)
9142  CASE DEFAULT
9143  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9144  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9145  & " is invalid for a finite elasticity problem."
9146  CALL flagerror(local_error,err,error,*999)
9147  END SELECT
9148  CASE(problem_setup_solver_equations_type)
9149  SELECT CASE(problem_setup%ACTION_TYPE)
9150  CASE(problem_setup_start_action)
9151  !Get the control loop
9152  control_loop_root=>problem%CONTROL_LOOP
9153  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9154  !Get the solver
9155  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9156  CALL solvers_solver_get(solvers,1,nonlinearsolver,err,error,*999)
9157  !Create the solver equatgions
9158  CALL solver_equations_create_start(nonlinearsolver,solver_equations,err,error,*999)
9159  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
9160  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
9161  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
9162  CASE(problem_setup_finish_action)
9163  !Get the control loop
9164  control_loop_root=>problem%CONTROL_LOOP
9165  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
9166  !Get the solver equations
9167  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
9168  CALL solvers_solver_get(solvers,1,nonlinearsolver,err,error,*999)
9169  CALL solver_solver_equations_get(nonlinearsolver,solver_equations,err,error,*999)
9170  !Finish the solver equations creation
9171  CALL solver_equations_create_finish(solver_equations,err,error,*999)
9172  CASE DEFAULT
9173  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
9174  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9175  & " is invalid for a finite elasticity problem."
9176  CALL flagerror(local_error,err,error,*999)
9177  END SELECT
9178  CASE DEFAULT
9179  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
9180  & " is invalid for a finite elasticity problem."
9181  CALL flagerror(local_error,err,error,*999)
9182  END SELECT
9183  CASE DEFAULT
9184  local_error="Problem subtype "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
9185  & " is not valid for a finite elasticity contact type of an elasticity problem class."
9186  CALL flagerror(local_error,err,error,*999)
9187  END SELECT
9188  ELSE
9189  CALL flagerror("Problem is not associated.",err,error,*999)
9190  ENDIF
9191 
9192  exits("FiniteElasticity_ContactProblemSetup")
9193  RETURN
9194 999 errorsexits("FiniteElasticity_ContactProblemSetup",err,error)
9195  RETURN 1
9196  END SUBROUTINE finiteelasticity_contactproblemsetup
9197 
9198  !
9199  !================================================================================================================================
9200  !
9201 
9203  SUBROUTINE finiteelasticity_problemspecificationset(problem,problemSpecification,err,error,*)
9204 
9205  !Argument variables
9206  TYPE(problem_type), POINTER :: problem
9207  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
9208  INTEGER(INTG), INTENT(OUT) :: err
9209  TYPE(varying_string), INTENT(OUT) :: error
9210  !Local Variables
9211  TYPE(varying_string) :: localError
9212  INTEGER(INTG) :: problemSubtype
9213 
9214  enters("FiniteElasticity_ProblemSpecificationSet",err,error,*999)
9215 
9216  IF(ASSOCIATED(problem)) THEN
9217  IF(SIZE(problemspecification,1)<3) THEN
9218  !Default to no subtype if not set
9219  problemsubtype=problem_no_subtype
9220  ELSE IF(SIZE(problemspecification,1)==3) THEN
9221  problemsubtype=problemspecification(3)
9222  SELECT CASE(problemsubtype)
9223  CASE(problem_no_subtype)
9224  !ok
9225  CASE(problem_quasistatic_finite_elasticity_subtype)
9226  !ok
9227  CASE(problem_finite_elasticity_cellml_subtype)
9228  !ok
9229  CASE(problem_multiscale_finite_elasticity_subtype)
9230  !ok
9231  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
9232  !ok
9233  CASE DEFAULT
9234  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
9235  & " is not valid for a finite elasticity type of an elasticity problem."
9236  CALL flagerror(localerror,err,error,*999)
9237  END SELECT
9238  ELSE
9239  CALL flagerror("Finite elasticity problem specification may only have up to 3 entries.",err,error,*999)
9240  END IF
9241  IF(ALLOCATED(problem%specification)) THEN
9242  CALL flagerror("Problem specification is already allocated.",err,error,*999)
9243  ELSE
9244  ALLOCATE(problem%specification(3),stat=err)
9245  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
9246  END IF
9247  problem%specification(1:3)=[problem_elasticity_class,problem_finite_elasticity_type,problemsubtype]
9248  ELSE
9249  CALL flagerror("Problem is not associated.",err,error,*999)
9250  ENDIF
9251 
9252  exits("FiniteElasticity_ProblemSpecificationSet")
9253  RETURN
9254 999 errors("FiniteElasticity_ProblemSpecificationSet",err,error)
9255  exits("FiniteElasticity_ProblemSpecificationSet")
9256  RETURN 1
9257 
9258  END SUBROUTINE finiteelasticity_problemspecificationset
9259 
9260  !
9261  !================================================================================================================================
9262  !
9263 
9265  SUBROUTINE finiteelasticity_contactproblemspecificationset(problem,problemSpecification,err,error,*)
9266 
9267  !Argument variables
9268  TYPE(problem_type), POINTER :: problem
9269  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
9270  INTEGER(INTG), INTENT(OUT) :: err
9271  TYPE(varying_string), INTENT(OUT) :: error
9272  !Local Variables
9273  TYPE(varying_string) :: localError
9274  INTEGER(INTG) :: problemSubtype
9275 
9276  enters("FiniteElasticity_ContactProblemSpecificationSet",err,error,*999)
9277 
9278  IF(ASSOCIATED(problem)) THEN
9279  IF(SIZE(problemspecification,1)<3) THEN
9280  !Default to no subtype if not set
9281  problemsubtype=problem_no_subtype
9282  ELSE IF(SIZE(problemspecification,1)==3) THEN
9283  problemsubtype=problemspecification(3)
9284  SELECT CASE(problemsubtype)
9285  CASE(problem_no_subtype)
9286  !Normal finite elasticity problem subject to contact constraint, no extra solvers required
9287  CASE(problem_fe_contact_transform_reproject_subtype)
9288  !ok
9289  CASE(problem_fe_contact_transform_subtype)
9290  !ok
9291  CASE(problem_fe_contact_reproject_subtype)
9292  !ok
9293  CASE DEFAULT
9294  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
9295  & " is not valid for a finite elasticity contact type of an elasticity problem."
9296  CALL flagerror(localerror,err,error,*999)
9297  END SELECT
9298  ELSE
9299  CALL flagerror("Finite elasticity contact problem specification may only have up to 3 entries.",err,error,*999)
9300  END IF
9301  IF(ALLOCATED(problem%specification)) THEN
9302  CALL flagerror("Problem specification is already allocated.",err,error,*999)
9303  ELSE
9304  ALLOCATE(problem%specification(3),stat=err)
9305  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
9306  END IF
9307  problem%specification(1:3)=[problem_elasticity_class,problem_finite_elasticity_contact_type,problemsubtype]
9308  ELSE
9309  CALL flagerror("Problem is not associated.",err,error,*999)
9310  ENDIF
9311 
9312  exits("FiniteElasticity_ContactProblemSpecificationSet")
9313  RETURN
9314 999 errors("FiniteElasticity_ContactProblemSpecificationSet",err,error)
9315  exits("FiniteElasticity_ContactProblemSpecificationSet")
9316  RETURN 1
9317 
9318  END SUBROUTINE finiteelasticity_contactproblemspecificationset
9319 
9320  !
9321  !================================================================================================================================
9322  !
9323 
9325  SUBROUTINE finite_elasticity_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
9326 
9327  !Argument variables
9328  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
9329  TYPE(solver_type), POINTER :: SOLVER
9330  INTEGER(INTG), INTENT(OUT) :: ERR
9331  TYPE(varying_string), INTENT(OUT) :: ERROR
9332 
9333  !Local Variables
9334  INTEGER(INTG) :: I
9335  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
9336 
9337  enters("FINITE_ELASTICITY_POST_SOLVE",err,error,*999)
9338 
9339  IF(ASSOCIATED(control_loop)) THEN
9340  IF(ASSOCIATED(solver)) THEN
9341  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
9342  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
9343  CALL flagerror("Problem specification is not allocated.",err,error,*999)
9344  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
9345  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
9346  END IF
9347  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
9348  CASE(problem_finite_elasticity_with_growth_cellml_subtype)
9349  IF(solver%GLOBAL_NUMBER==2) THEN
9350  !Nonlinear solver
9351  CALL solver_nonlinear_divergence_exit(solver,err,error,*999)
9352  CALL finite_elasticity_post_solve_output_data(control_loop,solver,err,error,*999)
9353  ENDIF
9354  CASE(problem_standard_elasticity_darcy_subtype,problem_pgm_elasticity_darcy_subtype, &
9355  & problem_quasistatic_elasticity_transient_darcy_subtype,problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
9356  !Call divergence test only if finite element loop: THIS IS NOT A PROPER FIX
9357  IF(control_loop%SUB_LOOP_INDEX==1) THEN
9358  CALL solver_nonlinear_divergence_exit(solver,err,error,*999)
9359  ENDIF
9360  IF(control_loop%LOOP_TYPE==problem_control_load_increment_loop_type.AND.solver%GLOBAL_NUMBER==1) THEN
9361  CALL finite_elasticity_post_solve_output_data(control_loop,solver,err,error,*999)
9362  END IF
9363  CASE(problem_quasistatic_finite_elasticity_subtype)
9364  ! how to check eqn subtype? assume active contraction
9365  independent_field=>solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
9366  & equations_sets(1)%PTR%INDEPENDENT%INDEPENDENT_FIELD
9367  ! store lambda Q (7-10) in prev lambda Q (3-6)
9368  DO i=1,4
9369  CALL field_parameterstofieldparameterscopy(independent_field,&
9370  & field_u_variable_type,field_values_set_type,i+6, &
9371  & independent_field,field_u_variable_type,field_values_set_type,i+2,err,error,*999)
9372  END DO
9373  ! output data
9374  CALL finite_elasticity_post_solve_output_data(control_loop,solver,err,error,*999)
9375  CASE(problem_multiscale_finite_elasticity_subtype)
9376  IF(ASSOCIATED(solver%DAE_SOLVER)) THEN
9377  !do nothing
9378  ELSE IF(ASSOCIATED(solver%NONLINEAR_SOLVER)) THEN
9379  CALL solver_nonlinear_divergence_exit(solver,err,error,*999)
9380  END IF
9381  CASE DEFAULT
9382  !Check that solver converged
9383  CALL solver_nonlinear_divergence_exit(solver,err,error,*999)
9384  END SELECT
9385  ELSE
9386  CALL flagerror("Problem is not associated.",err,error,*999)
9387  ENDIF
9388  ELSE
9389  CALL flagerror("Solver is not associated.",err,error,*999)
9390  ENDIF
9391  ELSE
9392  CALL flagerror("Control loop is not associated.",err,error,*999)
9393  ENDIF
9394 
9395  exits("FINITE_ELASTICITY_POST_SOLVE")
9396  RETURN
9397 999 errorsexits("FINITE_ELASTICITY_POST_SOLVE",err,error)
9398  RETURN 1
9399  END SUBROUTINE finite_elasticity_post_solve
9400 
9401  !
9402  !================================================================================================================================
9403  !
9404 
9406  SUBROUTINE finite_elasticity_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
9407 
9408  !Argument variables
9409  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
9410  TYPE(solver_type), POINTER :: SOLVER
9411  INTEGER(INTG), INTENT(OUT) :: ERR
9412  TYPE(varying_string), INTENT(OUT) :: ERROR
9413 
9414  !Local Variables
9415  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
9416  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
9417  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
9418  TYPE(control_loop_type), POINTER :: TIME_LOOP
9419  TYPE(varying_string) :: LOCAL_ERROR
9420  TYPE(varying_string) :: METHOD !,FILE
9421  CHARACTER(14) :: FILE
9422  CHARACTER(14) :: OUTPUT_FILE
9423  LOGICAL :: EXPORT_FIELD
9424  INTEGER(INTG) :: CURRENT_LOOP_ITERATION
9425  INTEGER(INTG) :: OUTPUT_ITERATION_NUMBER
9426  INTEGER(INTG) :: equations_set_idx,loop_idx
9427 
9428  enters("FINITE_ELASTICITY_POST_SOLVE_OUTPUT_DATA",err,error,*999)
9429 
9430  IF(ASSOCIATED(control_loop)) THEN
9431  IF(ASSOCIATED(solver)) THEN
9432  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
9433  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
9434  CALL flagerror("Problem specification is not allocated.",err,error,*999)
9435  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
9436  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
9437  END IF
9438  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
9439  CASE(problem_no_subtype,problem_standard_elasticity_fluid_pressure_subtype, &
9440  & problem_finite_elasticity_cellml_subtype,problem_multiscale_finite_elasticity_subtype, &
9441  & problem_finite_elasticity_with_growth_cellml_subtype)
9442  solver_equations=>solver%SOLVER_EQUATIONS
9443  IF(ASSOCIATED(solver_equations)) THEN
9444  solver_mapping=>solver_equations%SOLVER_MAPPING
9445  IF(ASSOCIATED(solver_mapping)) THEN
9446  !Make sure the equations sets are up to date
9447  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
9448  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
9449  method="FORTRAN"
9450  !EXPORT_FIELD=.TRUE.
9451  export_field=.false.
9452  IF(export_field) THEN
9453  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
9454  CALL write_string(general_output_type,"Finite Elasticity export fields ... ",err,error,*999)
9455  CALL write_string(general_output_type,"STATICSOLUTION",err,error,*999)
9456  ENDIF
9457  CALL fluid_mechanics_io_write_cmgui(equations_set%REGION,equations_set%GLOBAL_NUMBER, &
9458  & "STATICSOLIDSOLUTION",err,error,*999)
9459  ENDIF
9460  ENDDO
9461  ENDIF
9462  ENDIF
9463  CASE(problem_standard_elasticity_darcy_subtype,problem_pgm_elasticity_darcy_subtype, &
9464  & problem_quasistatic_finite_elasticity_subtype,problem_quasistatic_elasticity_transient_darcy_subtype, &
9465  & problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
9466  solver_equations=>solver%SOLVER_EQUATIONS
9467  IF(ASSOCIATED(solver_equations)) THEN
9468  solver_mapping=>solver_equations%SOLVER_MAPPING
9469  IF(ASSOCIATED(solver_mapping)) THEN
9470  !Make sure the equations sets are up to date
9471  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
9472  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
9473  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
9474  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
9475  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
9476  CALL flagerror("Equations set specification does not have a type.", &
9477  & err,error,*999)
9478  END IF
9479  IF(equations_set%SPECIFICATION(2)==equations_set_finite_elasticity_type) THEN
9480  time_loop=>control_loop !Initialise time loop (load increment loop on first)
9481  !Move up to find outer time loop
9482  DO loop_idx=1,control_loop%CONTROL_LOOP_LEVEL-1
9483  IF(ASSOCIATED(time_loop%PARENT_LOOP)) THEN
9484  time_loop=>time_loop%PARENT_LOOP
9485  ELSE
9486  CALL flagerror("Could not find a time control loop.",err,error,*999)
9487  ENDIF
9488  ENDDO
9489  current_loop_iteration=time_loop%TIME_LOOP%ITERATION_NUMBER
9490  output_iteration_number=time_loop%TIME_LOOP%OUTPUT_NUMBER
9491 
9492  !Write out fields at each timestep
9493  IF(time_loop%TIME_LOOP%CURRENT_TIME<=time_loop%TIME_LOOP%STOP_TIME) THEN
9494  WRITE(output_file,'("S_TIMESTP_",I4.4)') current_loop_iteration
9495  file=output_file
9496  method="FORTRAN"
9497  export_field=.true.
9498  IF(export_field) THEN
9499  IF(output_iteration_number/=0.AND.mod(current_loop_iteration,output_iteration_number)==0) THEN
9500  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
9501  CALL write_string(general_output_type,"Finite Elasticity export fields ...",err,error,*999)
9502  CALL write_string(general_output_type,output_file,err,error,*999)
9503  ENDIF
9504  CALL fluid_mechanics_io_write_cmgui(equations_set%REGION,equations_set%GLOBAL_NUMBER,file, &
9505  & err,error,*999)
9506  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
9507  CALL write_string(general_output_type,"Finite Elasticity all fields exported ...",err,error,*999)
9508  ENDIF
9509  CALL write_string(diagnostic_output_type,output_file,err,error,*999)
9510  ENDIF
9511  ENDIF
9512  ENDIF !stop_time
9513  ENDIF !EQUATIONS_SET_FINITE_ELASTICITY_TYPE
9514  ENDDO !equations_set_idx
9515  ENDIF !Solver_mapping
9516  ENDIF !Solver_equations
9517  CASE DEFAULT
9518  local_error="The third problem specification of "// &
9519  & trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
9520  & " is not valid for a finite elasticity problem class."
9521  CALL flagerror(local_error,err,error,*999)
9522  END SELECT
9523  ELSE
9524  CALL flagerror("Problem is not associated.",err,error,*999)
9525  ENDIF
9526  ELSE
9527  CALL flagerror("Solver is not associated.",err,error,*999)
9528  ENDIF
9529  ELSE
9530  CALL flagerror("Control loop is not associated.",err,error,*999)
9531  ENDIF
9532 
9533  exits("FINITE_ELASTICITY_POST_SOLVE_OUTPUT_DATA")
9534  RETURN
9535 999 errorsexits("FINITE_ELASTICITY_POST_SOLVE_OUTPUT_DATA",err,error)
9536  RETURN 1
9537  END SUBROUTINE finite_elasticity_post_solve_output_data
9538 
9539  !
9540  !================================================================================================================================
9541  !
9542 
9544  SUBROUTINE finiteelasticity_controltimelooppreloop(CONTROL_LOOP,ERR,ERROR,*)
9545 
9546  !Argument variables
9547  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
9548  INTEGER(INTG), INTENT(OUT) :: ERR
9549  TYPE(varying_string), INTENT(OUT) :: ERROR
9550 
9551  !Local Variables
9552  TYPE(solver_type), POINTER :: SOLVER_SOLID
9553  TYPE(control_loop_type), POINTER :: CONTROL_LOOP_SOLID
9554  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
9555 
9556  NULLIFY(solver_solid)
9557  NULLIFY(control_loop_solid)
9558 
9559  enters("FiniteElasticity_ControlTimeLoopPreLoop",err,error,*999)
9560 
9561  IF(ASSOCIATED(control_loop)) THEN
9562  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
9563  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
9564  CALL flagerror("Problem specification is not allocated.",err,error,*999)
9565  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
9566  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
9567  END IF
9568  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
9569  CASE(problem_quasistatic_finite_elasticity_subtype)
9570  control_loop_solid=>control_loop
9571  CALL solvers_solver_get(control_loop_solid%SOLVERS,1,solver_solid,err,error,*999)
9572  independent_field=>solver_solid%SOLVER_EQUATIONS%SOLVER_MAPPING% &
9573  & equations_sets(1)%PTR%INDEPENDENT%INDEPENDENT_FIELD !?
9574  ! set component 1 to dt
9575  CALL field_component_values_initialise(independent_field,field_u_variable_type, &
9576  & field_values_set_type,1,control_loop%TIME_LOOP%TIME_INCREMENT,err,error,*999)
9577  ! set component 2 to current time.
9578  CALL field_component_values_initialise(independent_field,field_u_variable_type, &
9579  & field_values_set_type,2,control_loop%TIME_LOOP%CURRENT_TIME,err,error,*999)
9580  CASE(problem_standard_elasticity_darcy_subtype,problem_standard_elasticity_fluid_pressure_subtype)
9581  ! could do this in one line with problem_solver_get but the dependence on problem_routines causes a circular dependence
9582  CALL control_loop_get(control_loop,[1,control_loop_node],control_loop_solid,err,error,*999)
9583  CALL solvers_solver_get(control_loop_solid%SOLVERS,1,solver_solid,err,error,*999)
9584  !--- 3.0 For Standard Elasticity Darcy: Update the boundary conditions of the solid
9585  CALL finiteelasticity_presolveupdateboundaryconditions(control_loop,solver_solid,err,error,*999)
9586  CASE(problem_quasistatic_elasticity_transient_darcy_subtype,problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
9587  CALL control_loop_get(control_loop,[1,1,control_loop_node],control_loop_solid,err,error,*999)
9588  CALL solvers_solver_get(control_loop_solid%SOLVERS,1,solver_solid,err,error,*999)
9589  !--- 3.0 For Standard Elasticity Darcy: Update the boundary conditions of the solid
9590  CALL finiteelasticity_presolveupdateboundaryconditions(control_loop,solver_solid,err,error,*999)
9591  CASE(problem_pgm_elasticity_darcy_subtype)
9592  CALL control_loop_get(control_loop,[1,control_loop_node],control_loop_solid,err,error,*999)
9593  CALL solvers_solver_get(control_loop_solid%SOLVERS,1,solver_solid,err,error,*999)
9594  !--- For PGM: Get the displacement field
9595  CALL finiteelasticity_presolvegetsoliddisplacement(control_loop,solver_solid,err,error,*999)
9596  CASE DEFAULT
9597  !do nothing
9598  END SELECT
9599  ELSE
9600  CALL flagerror("Problem is not associated.",err,error,*999)
9601  ENDIF
9602  ELSE
9603  CALL flagerror("Control loop is not associated.",err,error,*999)
9604  ENDIF
9605 
9606  exits("FiniteElasticity_ControlTimeLoopPreLoop")
9607  RETURN
9608 999 errorsexits("FiniteElasticity_ControlTimeLoopPreLoop",err,error)
9609  RETURN 1
9610 
9611  END SUBROUTINE finiteelasticity_controltimelooppreloop
9612 
9613  !
9614  !================================================================================================================================
9615  !
9616 
9618  SUBROUTINE finiteelasticity_controlloadincrementlooppostloop(controlLoop,err,error,*)
9619 
9620  !Argument variables
9621  TYPE(control_loop_type), POINTER :: controlLoop
9622  INTEGER(INTG), INTENT(OUT) :: err
9623  TYPE(varying_string), INTENT(OUT) :: error
9624  !Local Variables
9625  TYPE(solvers_type), POINTER :: solvers
9626  TYPE(solver_type), POINTER :: solver
9627  TYPE(solver_equations_type), POINTER :: solverEquations
9628  TYPE(solver_mapping_type), POINTER :: solverMapping
9629  TYPE(region_type), POINTER :: region
9630  TYPE(fields_type), POINTER :: fields
9631  INTEGER(INTG) :: solverIdx,equationsSetIdx,incrementIdx,outputNumber
9632  LOGICAL :: dirExist
9633  TYPE(varying_string) :: fileName,method,directory
9634 
9635  enters("FiniteElasticity_ControlLoadIncrementLoopPostLoop",err,error,*999)
9636 
9637  IF(ASSOCIATED(controlloop)) THEN
9638  IF(controlloop%LOOP_TYPE==problem_control_load_increment_loop_type) THEN
9639  incrementidx=controlloop%LOAD_INCREMENT_LOOP%ITERATION_NUMBER
9640  outputnumber=controlloop%LOAD_INCREMENT_LOOP%OUTPUT_NUMBER
9641  IF(outputnumber>0) THEN
9642  IF(mod(incrementidx,outputnumber)==0) THEN
9643  solvers=>controlloop%SOLVERS
9644  IF(ASSOCIATED(solvers)) THEN
9645  DO solveridx=1,solvers%NUMBER_OF_SOLVERS
9646  solver=>solvers%SOLVERS(solveridx)%PTR
9647  IF(ASSOCIATED(solver)) THEN
9648  solverequations=>solver%SOLVER_EQUATIONS
9649  IF(ASSOCIATED(solverequations)) THEN
9650  solvermapping=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING
9651  IF(ASSOCIATED(solvermapping)) THEN
9652  DO equationssetidx=1,solvermapping%NUMBER_OF_EQUATIONS_SETS
9653  region=>solvermapping%EQUATIONS_SETS(equationssetidx)%PTR%REGION
9654  NULLIFY(fields)
9655  fields=>region%FIELDS
9656  directory="results_load/"
9657  INQUIRE(file=char(directory),exist=direxist)
9658  IF(.NOT.direxist) THEN
9659  CALL system(char("mkdir "//directory))
9660  ENDIF
9661  filename=directory//"mesh"//trim(number_to_vstring(equationssetidx,"*",err,error))// &
9662  & "_load"//trim(number_to_vstring(incrementidx,"*",err,error))
9663  method="FORTRAN"
9664  CALL field_io_elements_export(fields,filename,method,err,error,*999)
9665  CALL field_io_nodes_export(fields,filename,method,err,error,*999)
9666  ENDDO !equationsSetIdx
9667  ENDIF
9668  ENDIF
9669  ENDIF
9670  ENDDO !solverIdx
9671  ELSE
9672  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
9673  ENDIF
9674  ENDIF
9675  ENDIF
9676  ENDIF
9677  ELSE
9678  CALL flagerror("Control loop is not associated.",err,error,*999)
9679  ENDIF
9680 
9681  exits("FiniteElasticity_ControlLoadIncrementLoopPostLoop")
9682  RETURN
9683 999 errors("FiniteElasticity_ControlLoadIncrementLoopPostLoop",err,error)
9684  exits("FiniteElasticity_ControlLoadIncrementLoopPostLoop")
9685  RETURN 1
9686 
9687  END SUBROUTINE finiteelasticity_controlloadincrementlooppostloop
9688 
9689  !
9690  !================================================================================================================================
9691  !
9692 
9694  SUBROUTINE finite_elasticity_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
9695 
9696  !Argument variables
9697  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
9698  TYPE(solver_type), POINTER :: SOLVER
9699  INTEGER(INTG), INTENT(OUT) :: ERR
9700  TYPE(varying_string), INTENT(OUT) :: ERROR
9701 
9702  !Local Variables
9703  INTEGER(INTG) :: solver_matrix_idx,equations_set_idx
9704  LOGICAL :: CELLMLSOLVER,NONLINEARSOLVER,VALID_SUBTYPE
9705  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
9706  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
9707  TYPE(field_type), POINTER :: DEPENDENT_FIELD
9708  TYPE(solver_type), POINTER :: CELLML_SOLVER
9709  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
9710  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
9711  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
9712  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
9713  TYPE(varying_string) :: LOCAL_ERROR
9714 
9715  enters("FINITE_ELASTICITY_PRE_SOLVE",err,error,*999)
9716 
9717  IF(ASSOCIATED(control_loop)) THEN
9718  IF(ASSOCIATED(solver)) THEN
9719  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
9720  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
9721  CALL flagerror("Problem specification is not allocated.",err,error,*999)
9722  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
9723  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
9724  END IF
9725  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
9726  CASE(problem_no_subtype)
9727  ! do nothing ???
9728  CASE(problem_finite_elasticity_cellml_subtype, &
9729  problem_finite_elasticity_with_growth_cellml_subtype)
9730  IF(control_loop%PROBLEM%SPECIFICATION(3)==problem_finite_elasticity_with_growth_cellml_subtype) THEN
9731  IF(solver%GLOBAL_NUMBER==1) THEN
9732  cellmlsolver=.true.
9733  nonlinearsolver=.false.
9734  ELSE
9735  cellmlsolver=.false.
9736  nonlinearsolver=.true.
9737  ENDIF
9738  ELSE
9739  cellmlsolver=.false.
9740  nonlinearsolver=.true.
9741  ENDIF
9742  IF(cellmlsolver) THEN
9743  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
9744  CALL solver_dae_times_set(solver,current_time,current_time+time_increment,err,error,*999)
9745  ENDIF
9746  IF(nonlinearsolver) THEN
9747  solver_equations=>solver%SOLVER_EQUATIONS
9748  IF(ASSOCIATED(solver_equations)) THEN
9749  solver_mapping=>solver_equations%SOLVER_MAPPING
9750  IF(ASSOCIATED(solver_mapping)) THEN
9751  valid_subtype=.false.
9752  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
9753  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
9754  IF(equations_set%SPECIFICATION(3)==equations_set_constitutive_law_in_cellml_evaluate_subtype.OR. &
9755  equations_set%SPECIFICATION(3)==equations_set_constitutive_and_growth_law_in_cellml_subtype) THEN
9756  valid_subtype=.true.
9757  !compute the strain field
9758  dependent_field=>equations_set%EQUATIONS%INTERPOLATION%DEPENDENT_FIELD
9759  CALL finiteelasticity_straincalculate(equations_set,dependent_field, &
9760  & field_u1_variable_type,err,error,*999)
9761  !check for a linked CellML solver
9762  cellml_solver=>solver%NONLINEAR_SOLVER%NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
9763  IF(ASSOCIATED(cellml_solver)) THEN
9764  !evaluate the constiutive equation in CellML
9765  CALL solver_solve(cellml_solver,err,error,*999)
9766  ENDIF
9767  ENDIF
9768  ENDDO !equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS
9769  IF(valid_subtype .NEQV. .true.) THEN
9770  local_error="The third equations set specification of "// &
9771  & trim(number_to_vstring(equations_set%specification(3),"*",err, &
9772  & error))//"is not valid for a finite elasticity third problem specification of "//trim( &
9773  & number_to_vstring(control_loop%PROBLEM%specification(3),"*",err,error))//"."
9774  CALL flagerror(local_error,err,error,*999)
9775  ENDIF
9776  ELSE
9777  CALL flagerror("Solver mapping is not associated.",err,error,*999)
9778  ENDIF
9779  ELSE
9780  CALL flagerror("Solver equations is not associated.",err,error,*999)
9781  ENDIF
9782  ENDIF
9783  CASE(problem_quasistatic_finite_elasticity_subtype)
9784  ! do nothing, time values get updated in CONTROL_TIME_LOOP_PRE_LOOP as there might be
9785  ! a load increment loop below the time loop, so we don't want to update times here before
9786  ! every solve
9787  CASE(problem_gudunov_monodomain_simple_elasticity_subtype)
9788  ! do nothing
9789  CASE(problem_gudunov_monodomain_1d3d_elasticity_subtype,problem_monodomain_elasticity_w_titin_subtype)
9790  ! do nothing
9791  CASE(problem_monodomain_elasticity_velocity_subtype)
9792  ! do nothing
9793  CASE(problem_multiscale_finite_elasticity_subtype)
9794  ! do nothing
9795  CASE(problem_monodomain_1d3d_active_strain_subtype)
9796  !evaluate the evolution law using the cell model variables of the current time step and the deformation gradient tensor of the previous time step
9797  CALL finite_elasticity_evaluate_evolution_law(solver,err,error,*999)
9798  CASE(problem_standard_elasticity_fluid_pressure_subtype)
9799  ! do nothing
9800  CASE(problem_standard_elasticity_darcy_subtype,problem_pgm_elasticity_darcy_subtype, &
9801  & problem_quasistatic_elasticity_transient_darcy_subtype,problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
9802  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
9803  CALL write_string(general_output_type,"Finite Elasticity pre-solve",err,error,*999)
9804  ENDIF
9805 
9806  !--- Set 'SOLVER_MATRIX%UPDATE_MATRIX=.TRUE.'
9807  solver_equations=>solver%SOLVER_EQUATIONS
9808  IF(ASSOCIATED(solver_equations)) THEN
9809  solver_mapping=>solver_equations%SOLVER_MAPPING
9810  IF(ASSOCIATED(solver_mapping)) THEN
9811  solver_matrices=>solver_equations%SOLVER_MATRICES
9812  IF(ASSOCIATED(solver_matrices)) THEN
9813  DO solver_matrix_idx=1,solver_mapping%NUMBER_OF_SOLVER_MATRICES
9814  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
9815  IF(ASSOCIATED(solver_matrix)) THEN
9816  solver_matrix%UPDATE_MATRIX=.true.
9817  ELSE
9818  CALL flagerror("Solver Matrix is not associated.",err,error,*999)
9819  ENDIF
9820  ENDDO
9821  ELSE
9822  CALL flagerror("Solver Matrices is not associated.",err,error,*999)
9823  ENDIF
9824  ELSE
9825  CALL flagerror("Solver mapping is not associated.",err,error,*999)
9826  ENDIF
9827  ELSE
9828  CALL flagerror("Solver equations is not associated.",err,error,*999)
9829  ENDIF
9830  CASE DEFAULT
9831  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
9832  & " is not valid for a finite elasticity problem class."
9833  CALL flagerror(local_error,err,error,*999)
9834  END SELECT
9835  ELSE
9836  CALL flagerror("Problem is not associated.",err,error,*999)
9837  ENDIF
9838  ELSE
9839  CALL flagerror("Solver is not associated.",err,error,*999)
9840  ENDIF
9841  ELSE
9842  CALL flagerror("Control loop is not associated.",err,error,*999)
9843  ENDIF
9844 
9845  exits("FINITE_ELASTICITY_PRE_SOLVE")
9846  RETURN
9847 999 errorsexits("FINITE_ELASTICITY_PRE_SOLVE",err,error)
9848  RETURN 1
9849  END SUBROUTINE finite_elasticity_pre_solve
9850 
9851  !
9852  !================================================================================================================================
9853  !
9854 
9856  SUBROUTINE finite_elasticity_evaluate_evolution_law(SOLVER,ERR,ERROR,*)
9857 
9858  !Argument variables
9859  TYPE(solver_type), POINTER :: SOLVER
9860  INTEGER(INTG), INTENT(OUT) :: ERR
9861  TYPE(varying_string), INTENT(OUT) :: ERROR
9862 
9863  !Local Variables
9864  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
9865  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
9866  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
9867  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
9868  TYPE(varying_string) :: LOCAL_ERROR
9869  INTEGER(INTG) :: solver_matrix_idx,equations_set_idx
9870  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
9871  TYPE(field_type), POINTER :: DEPENDENT_FIELD,INDEPENDENT_FIELD,FIBRE_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
9872  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
9873  INTEGER(INTG) :: gauss_idx,element_idx,ne
9874  INTEGER(INTG) :: DEPENDENT_NUMBER_OF_GAUSS_POINTS
9875  TYPE(basis_type), POINTER :: DEPENDENT_BASIS
9876  TYPE(equations_type), POINTER :: EQUATIONS
9877  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
9878  TYPE(quadrature_scheme_type), POINTER :: DEPENDENT_QUADRATURE_SCHEME
9879  TYPE(field_interpolation_parameters_type), POINTER :: GEOMETRIC_INTERPOLATION_PARAMETERS,INDEPENDENT_INTERPOLATION_PARAMETERS, &
9880  & FIBRE_INTERPOLATION_PARAMETERS,MATERIALS_INTERPOLATION_PARAMETERS,DEPENDENT_INTERPOLATION_PARAMETERS
9881  TYPE(field_interpolated_point_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT,FIBRE_INTERPOLATED_POINT, &
9882  & MATERIALS_INTERPOLATED_POINT,DEPENDENT_INTERPOLATED_POINT,INDEPENDENT_INTERPOLATED_POINT
9883  TYPE(field_interpolated_point_metrics_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT_METRICS, &
9884  & DEPENDENT_INTERPOLATED_POINT_METRICS
9885  TYPE(basis_type), POINTER :: GEOMETRIC_BASIS
9886  TYPE(decomposition_type), POINTER :: DECOMPOSITION
9887  INTEGER(INTG) :: FIELD_VAR_TYPE
9888  INTEGER(INTG) :: dof_idx,idx,i,j,LWORK
9889  INTEGER(INTG) :: MESH_COMPONENT_NUMBER
9890  REAL(DP) :: DZDXI(3,3),DZDNU(3,3),DZDNUT(3,3),TEMP(3,3)
9891  REAL(DP), DIMENSION (:), POINTER :: C !Parameters for constitutive laws
9892  REAL(DP) :: VALUE
9893  REAL(DP) :: TOL,TOL1,UP,LOW
9894  REAL(DP) :: F_e(3,3),F_a_inv(3,3),F_a_inv_T(3,3),F_a_T(3,3),C_a(3,3),C_a_inv(3,3),lambda_a,C_e(3,3),F_e_T(3,3)
9895  REAL(DP) :: REFERENCE_VOLUME,XB_STIFFNESS,XB_DISTORTION
9896  REAL(DP) :: SARCO_LENGTH,FREE_ENERGY,FREE_ENERGY_0,XB_ENERGY_PER_VOLUME,SLOPE,lambda_f,A_1,A_2,x_1,x_2
9897  REAL(DP) :: MAX_XB_NUMBER_PER_VOLUME,ENERGY_PER_XB,FORCE_LENGTH,I_1e,EVALUES(3),EVECTOR_1(3),EVECTOR_2(3),EVECTOR_3(3)
9898  REAL(DP) :: EMATRIX_1(3,3),EMATRIX_2(3,3),EMATRIX_3(3,3),TEMP1(3,3),TEMP2(3,3),TEMP3(3,3),N1(3,3),N2(3,3),N3(3,3)
9899  INTEGER(INTG), PARAMETER :: LWMAX=1000
9900  REAL(DP) :: WORK(lwmax)
9901 
9902  enters("FINITE_ELASTICITY_EVALUATE_EVOLUTION_LAW",err,error,*999)
9903 
9904  NULLIFY(elements_mapping)
9905  NULLIFY(decomposition)
9906  NULLIFY(dependent_basis,geometric_basis)
9907  NULLIFY(equations)
9908  NULLIFY(dependent_field,fibre_field,geometric_field,materials_field,independent_field)
9909  NULLIFY(field_variable)
9910  NULLIFY(dependent_quadrature_scheme)
9911  NULLIFY(geometric_interpolation_parameters,fibre_interpolation_parameters)
9912  NULLIFY(materials_interpolation_parameters,dependent_interpolation_parameters)
9913  NULLIFY(independent_interpolation_parameters)
9914  NULLIFY(geometric_interpolated_point,fibre_interpolated_point)
9915  NULLIFY(geometric_interpolated_point_metrics,dependent_interpolated_point_metrics)
9916  NULLIFY(materials_interpolated_point,dependent_interpolated_point)
9917  NULLIFY(independent_interpolated_point)
9918 
9919  !compute the deformation gradient tensor at the Gauss point
9920  solver_equations=>solver%SOLVER_EQUATIONS
9921  IF(ASSOCIATED(solver_equations)) THEN
9922  solver_mapping=>solver_equations%SOLVER_MAPPING
9923  IF(ASSOCIATED(solver_mapping)) THEN
9924  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
9925  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
9926  equations=>equations_set%EQUATIONS
9927 
9928  fibre_field =>equations%INTERPOLATION%FIBRE_FIELD
9929  geometric_field =>equations%INTERPOLATION%GEOMETRIC_FIELD
9930  materials_field =>equations%INTERPOLATION%MATERIALS_FIELD
9931  dependent_field =>equations%INTERPOLATION%DEPENDENT_FIELD
9932  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
9933 
9934  IF(equations_set%SPECIFICATION(3)==equations_set_1d3d_monodomain_active_strain_subtype) THEN
9935 
9936  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
9937  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
9938  fibre_field=>equations%INTERPOLATION%FIBRE_FIELD
9939 
9940  decomposition=>dependent_field%DECOMPOSITION
9941 
9942  elements_mapping=>decomposition%DOMAIN(decomposition%MESH_COMPONENT_NUMBER)% &
9943  & ptr%MAPPINGS%ELEMENTS
9944 
9945  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
9946  ne=elements_mapping%DOMAIN_LIST(element_idx)
9947 
9948  mesh_component_number=decomposition%MESH_COMPONENT_NUMBER
9949 
9950  dependent_basis=>decomposition%DOMAIN(mesh_component_number)%PTR%TOPOLOGY%ELEMENTS% &
9951  & elements(ne)%BASIS
9952  dependent_quadrature_scheme=>dependent_basis%QUADRATURE% &
9953  & quadrature_scheme_map(basis_default_quadrature_scheme)%PTR
9954  dependent_number_of_gauss_points=dependent_quadrature_scheme%NUMBER_OF_GAUSS
9955  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%&
9956  & ptr%TOPOLOGY%ELEMENTS%ELEMENTS(ne)%BASIS
9957 
9958  !Initialise tensors and matrices
9959  dzdnu=0.0_dp
9960  DO idx=1,3
9961  dzdnu(idx,idx)=1.0_dp
9962  ENDDO
9963 
9964  !Grab interpolation parameters
9965  field_var_type=equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR%VARIABLE_TYPE
9966  dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR
9967  geometric_interpolation_parameters=>equations%INTERPOLATION% &
9968  & geometric_interp_parameters(field_u_variable_type)%PTR
9969  IF(ASSOCIATED(fibre_field)) THEN
9970  fibre_interpolation_parameters=>equations%INTERPOLATION%FIBRE_INTERP_PARAMETERS(field_u_variable_type)%PTR
9971  ENDIF
9972  IF(ASSOCIATED(materials_field)) THEN
9973  materials_interpolation_parameters=>equations%INTERPOLATION% &
9974  & materials_interp_parameters(field_u_variable_type)%PTR
9975  ENDIF
9976 ! INDEPENDENT_INTERPOLATION_PARAMETERS=>EQUATIONS%INTERPOLATION% &
9977 ! & INDEPENDENT_INTERP_PARAMETERS(FIELD_U_VARIABLE_TYPE)%PTR
9978 
9979  CALL field_interpolation_parameters_element_get(field_values_set_type,ne, &
9980  & geometric_interpolation_parameters,err,error,*999)
9981  IF(ASSOCIATED(fibre_field)) THEN
9982  CALL field_interpolation_parameters_element_get(field_values_set_type,ne, &
9983  & fibre_interpolation_parameters,err,error,*999)
9984  END IF
9985  IF(ASSOCIATED(materials_field)) THEN
9986  CALL field_interpolation_parameters_element_get(field_values_set_type,ne, &
9987  & materials_interpolation_parameters,err,error,*999)
9988  ENDIF
9989  CALL field_interpolation_parameters_element_get(field_values_set_type,ne, &
9990  & dependent_interpolation_parameters,err,error,*999)
9991 ! CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ne, &
9992 ! & INDEPENDENT_INTERPOLATION_PARAMETERS,ERR,ERROR,*999)
9993 
9994  !Point interpolation pointer
9995  geometric_interpolated_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
9996  geometric_interpolated_point_metrics=>equations%INTERPOLATION% &
9997  & geometric_interp_point_metrics(field_u_variable_type)%PTR
9998  IF(ASSOCIATED(fibre_field)) THEN
9999  fibre_interpolated_point=>equations%INTERPOLATION%FIBRE_INTERP_POINT(field_u_variable_type)%PTR
10000  END IF
10001  IF(ASSOCIATED(materials_field)) THEN
10002  materials_interpolated_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR
10003  ENDIF
10004  dependent_interpolated_point=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR
10005  dependent_interpolated_point_metrics=>equations%INTERPOLATION% &
10006  & dependent_interp_point_metrics(field_var_type)%PTR
10007 ! INDEPENDENT_INTERPOLATED_POINT=>EQUATIONS%INTERPOLATION%INDEPENDENT_INTERP_POINT(FIELD_U_VARIABLE_TYPE)%PTR
10008 
10009  c=>materials_interpolated_point%VALUES(:,1)
10010 
10011  !Loop over gauss points
10012  DO gauss_idx=1,dependent_number_of_gauss_points
10013 
10014  !Interpolate dependent, geometric, fibre and material fields
10015  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
10016  & dependent_interpolated_point,err,error,*999)
10017  CALL field_interpolated_point_metrics_calculate(dependent_basis%NUMBER_OF_XI, &
10018  & dependent_interpolated_point_metrics,err,error,*999)
10019  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
10020  & geometric_interpolated_point,err,error,*999)
10021  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI, &
10022  & geometric_interpolated_point_metrics,err,error,*999)
10023  IF(ASSOCIATED(fibre_field)) THEN
10024  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
10025  & fibre_interpolated_point,err,error,*999)
10026  END IF
10027  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
10028  & materials_interpolated_point,err,error,*999)
10029 ! CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,gauss_idx, &
10030 ! & INDEPENDENT_INTERPOLATED_POINT,ERR,ERROR,*999)
10031 
10032  !Calculate F=dZ/dNU, the deformation gradient tensor at the gauss point
10033  CALL finiteelasticity_gaussdeformationgradienttensor(dependent_interpolated_point_metrics, &
10034  & geometric_interpolated_point_metrics,fibre_interpolated_point,dzdnu,err,error,*999)
10035 
10036  !get A1, A2, x1, x2 at the Gauss point of the 3D finite elasticity element
10037  NULLIFY(field_variable)
10038  CALL field_variable_get(independent_field,field_u_variable_type,field_variable,err,error,*999)
10039 
10040  dof_idx=field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_idx,ne)
10041  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type, &
10042  & dof_idx,a_1,err,error,*999)
10043  dof_idx=field_variable%COMPONENTS(2)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_idx,ne)
10044  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type, &
10045  & dof_idx,a_2,err,error,*999)
10046  dof_idx=field_variable%COMPONENTS(3)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_idx,ne)
10047  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type, &
10048  & dof_idx,x_1,err,error,*999)
10049  dof_idx=field_variable%COMPONENTS(4)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_idx,ne)
10050  CALL field_parameter_set_get_local_dof(independent_field,field_u_variable_type,field_values_set_type, &
10051  & dof_idx,x_2,err,error,*999)
10052 
10053  !--------------------------------------------------------------------------------------------
10054  sarco_length=dzdnu(1,1)
10055  ! Calculate Filament-Overlap
10056  IF(sarco_length.LE.0.635_dp) THEN
10057  force_length=0.0_dp
10058  ELSE IF(sarco_length.LE.0.835_dp) THEN
10059  force_length=4.2_dp*(sarco_length-0.635_dp)
10060  ELSE IF(sarco_length.LE.1.0_dp) THEN
10061  force_length=0.84_dp+0.9697_dp*(sarco_length-0.835_dp)
10062  ELSE IF(sarco_length.LE.1.125_dp) THEN
10063  force_length=1.0_dp
10064  ELSE IF(sarco_length.LE.1.825_dp) THEN
10065  force_length=1.0_dp-1.4286_dp*(sarco_length-1.125_dp)
10066  ELSE
10067  force_length=0.0_dp
10068  ENDIF
10069 
10070  reference_volume=1.4965e-03_dp ! [micrometer^3]
10071  max_xb_number_per_volume=120.0_dp*2.0_dp/reference_volume ! [cross-bridges per micrometer^3]
10072  energy_per_xb=0.5_dp*x_2**2*c(8) ! [Newton times micrometer]
10073 
10074  !Mechanical Energy stored in cross-bridges
10075  xb_energy_per_volume=max_xb_number_per_volume*force_length*energy_per_xb*a_2 ! [Newton per micrometer^2]
10076  !Mechanical Energy stored in cross-bridges converted in Newton per cm^2
10077  xb_energy_per_volume=xb_energy_per_volume*1e+08_dp ! [Newton per cm^2]
10078 
10079  !Initalize lambda_a
10080  lambda_a=1.0_dp
10081 
10082  f_a_inv=0.0_dp
10083  f_a_inv(1,1)=1.0_dp/lambda_a
10084  f_a_inv(2,2)=1.0_dp
10085  f_a_inv(3,3)=1.0_dp
10086 
10087  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
10088  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
10089  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
10090 
10091  !Odgen law - 3 terms. Material Parameters C = [mu(1) mu(2) mu(3) alpha(1) alpha(2) alpha(3) mu_0]
10092  !CALL Eigenvalue(C_e,EVALUES,ERR,ERROR,*999)
10093  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
10094  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10095  lwork=min(lwmax,int(work(1)))
10096  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
10097  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10098  evector_1=c_e(:,1)
10099  evector_2=c_e(:,2)
10100  evector_3=c_e(:,3)
10101 
10102  DO i=1,3
10103  DO j=1,3
10104  ematrix_1(i,j)=evector_1(i)*evector_1(j)
10105  ematrix_2(i,j)=evector_2(i)*evector_2(j)
10106  ematrix_3(i,j)=evector_3(i)*evector_3(j)
10107  END DO
10108  END DO
10109 
10110  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
10111  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
10112  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
10113  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
10114  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
10115  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
10116 
10117  free_energy_0=0.0_dp
10118  DO i=1,3
10119  free_energy_0=free_energy_0+c(i)/c(i+3)*( &
10120  & evalues(1)**(c(i+3)/2.0_dp)+ &
10121  & evalues(2)**(c(i+3)/2.0_dp)+ &
10122  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
10123  END DO
10124  free_energy_0=c(7)*free_energy_0
10125 
10126  free_energy=free_energy_0
10127 
10128  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
10129 
10130  !tolerance for Newton's method
10131  tol=0.00001_dp
10132  !tolerance for the bisection method as preconditioner. Since Newton's method does not converge, we only use the bisection method here
10133  tol1=tol
10134  up=lambda_a
10135  low=0.001_dp
10136 
10137  DO WHILE (abs(VALUE).GE.tol)
10138 
10139  !bisection method
10140  IF (abs(VALUE).GE.tol1) THEN
10141  lambda_a=up-(up-low)/2.0_dp
10142 
10143  f_a_inv=0.0_dp
10144  f_a_inv(1,1)=1.0_dp/lambda_a
10145  f_a_inv(2,2)=1.0_dp
10146  f_a_inv(3,3)=1.0_dp
10147 
10148  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
10149  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
10150  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
10151 
10152  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
10153  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10154  lwork=min(lwmax,int(work(1)))
10155  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
10156  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10157  evector_1=c_e(:,1)
10158  evector_2=c_e(:,2)
10159  evector_3=c_e(:,3)
10160 
10161  DO i=1,3
10162  DO j=1,3
10163  ematrix_1(i,j)=evector_1(i)*evector_1(j)
10164  ematrix_2(i,j)=evector_2(i)*evector_2(j)
10165  ematrix_3(i,j)=evector_3(i)*evector_3(j)
10166  END DO
10167  END DO
10168 
10169  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
10170  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
10171  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
10172  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
10173  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
10174  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
10175 
10176  free_energy=0.0_dp
10177  DO i=1,3
10178  free_energy=free_energy+c(i)/c(i+3)*( &
10179  & evalues(1)**(c(i+3)/2.0_dp)+ &
10180  & evalues(2)**(c(i+3)/2.0_dp)+ &
10181  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
10182  END DO
10183  free_energy=c(7)*free_energy
10184 
10185  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
10186 
10187  IF (VALUE.GE.0) THEN
10188  up=lambda_a
10189  ELSE
10190  low=lambda_a
10191  ENDIF
10192 
10193  ELSE
10194  !Newton's method -- needs to be checked TODO
10195 
10196  temp=dzdnu+dzdnut
10197  CALL matrix_product(f_e_t,temp,temp,err,error,*999)
10198  CALL matrix_product(temp,n1,temp1,err,error,*999)
10199  CALL matrix_product(temp,n2,temp2,err,error,*999)
10200  CALL matrix_product(temp,n3,temp3,err,error,*999)
10201 
10202  temp=0.0_dp
10203  DO i=1,3
10204  temp=temp+ &
10205  & c(i)*evalues(1)**(c(i+3)/2.0_dp-1.0_dp)*temp1+ &
10206  & c(i)*evalues(2)**(c(i+3)/2.0_dp-1.0_dp)*temp2+ &
10207  & c(i)*evalues(3)**(c(i+3)/2.0_dp-1.0_dp)*temp3
10208  END DO
10209 
10210 ! SLOPE=TEMP(1,1)*C(7)
10211  lambda_a=lambda_a-VALUE/slope
10212  !IF (lambda_a.LE.0.0_DP) THEN
10213  ! lambda_a=0.1_DP
10214  !END IF
10215  !lambda_a=lambda_a-0.001
10216 
10217  f_a_inv=0.0_dp
10218  f_a_inv(1,1)=1.0_dp/lambda_a
10219  f_a_inv(2,2)=1.0_dp
10220  f_a_inv(3,3)=1.0_dp
10221 
10222  CALL matrix_product(dzdnu,f_a_inv,f_e,err,error,*999)
10223  CALL matrix_transpose(f_e,f_e_t,err,error,*999)
10224  CALL matrix_product(f_e_t,f_e,c_e,err,error,*999)
10225 
10226  CALL dsyev('V','U',3,c_e,3,evalues,work,-1,err)
10227  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10228  lwork=min(lwmax,int(work(1)))
10229  CALL dsyev('V','U',3,c_e,3,evalues,work,lwork,err)
10230  IF(err.NE.0) CALL flagerror("Error in Eigenvalue computation",err,error,*999)
10231  evector_1=c_e(:,1)
10232  evector_2=c_e(:,2)
10233  evector_3=c_e(:,3)
10234 
10235  DO i=1,3
10236  DO j=1,3
10237  ematrix_1(i,j)=evector_1(i)*evector_1(j)
10238  ematrix_2(i,j)=evector_2(i)*evector_2(j)
10239  ematrix_3(i,j)=evector_3(i)*evector_3(j)
10240  END DO
10241  END DO
10242 
10243  CALL matrix_product(f_a_inv,ematrix_1,n1,err,error,*999)
10244  CALL matrix_product(n1,f_a_inv,n1,err,error,*999) ! F_a_inv=F_a_inv_T
10245  CALL matrix_product(f_a_inv,ematrix_2,n2,err,error,*999)
10246  CALL matrix_product(n2,f_a_inv,n2,err,error,*999) ! F_a_inv=F_a_inv_T
10247  CALL matrix_product(f_a_inv,ematrix_3,n3,err,error,*999)
10248  CALL matrix_product(n3,f_a_inv,n3,err,error,*999) ! F_a_inv=F_a_inv_T
10249 
10250  free_energy=0.0_dp
10251  DO i=1,3
10252  free_energy=free_energy+c(i)/c(i+3)*( &
10253  & evalues(1)**(c(i+3)/2.0_dp)+ &
10254  & evalues(2)**(c(i+3)/2.0_dp)+ &
10255  & evalues(3)**(c(i+3)/2.0_dp)-3.0_dp)
10256  END DO
10257  free_energy=c(7)*free_energy
10258 
10259  VALUE=xb_energy_per_volume-(free_energy-free_energy_0)
10260  ENDIF
10261  ENDDO
10262 
10263  !store lambda_a at the Gauss point
10264  dof_idx=field_variable%COMPONENTS(5)%PARAM_TO_DOF_MAP%GAUSS_POINT_PARAM2DOF_MAP%GAUSS_POINTS(gauss_idx,ne)
10265  CALL field_parameter_set_update_local_dof(independent_field,field_u_variable_type,field_values_set_type, &
10266  & dof_idx,lambda_a,err,error,*999)
10267 
10268  ENDDO
10269  ENDDO
10270  ELSE
10271  local_error="This routine is not implemented for the third equations set specification of "// &
10272  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
10273  & " of a finite elasticity type of an elasticity equation set."
10274  CALL flagerror(local_error,err,error,*999)
10275  ENDIF
10276  ENDDO
10277  ENDIF
10278  ENDIF
10279 
10280  exits("FINITE_ELASTICITY_EVALUATE_EVOLUTION_LAW")
10281  RETURN
10282 999 errors("FINITE_ELASTICITY_EVALUATE_EVOLUTION_LAW",err,error)
10283  exits("FINITE_ELASTICITY_EVALUATE_EVOLUTION_LAW")
10284  RETURN 1
10285  END SUBROUTINE finite_elasticity_evaluate_evolution_law
10286 
10287  !
10288  !================================================================================================================================
10289  !
10291  SUBROUTINE finiteelasticity_presolvegetsoliddisplacement(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
10292 
10293  !Argument variables
10294  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
10295  TYPE(solver_type), POINTER :: SOLVER
10296  INTEGER(INTG), INTENT(OUT) :: ERR
10297  TYPE(varying_string), INTENT(OUT) :: ERROR
10298 
10299  !Local Variables
10300  TYPE(solver_type), POINTER :: SOLVER_FINITE_ELASTICITY
10301  TYPE(field_type), POINTER :: DEPENDENT_FIELD_FINITE_ELASTICITY
10302  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_FINITE_ELASTICITY
10303  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_FINITE_ELASTICITY
10304  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_FINITE_ELASTICITY
10305  TYPE(varying_string) :: LOCAL_ERROR
10306  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
10307 
10308  REAL(DP), POINTER :: MESH_DISPLACEMENT_VALUES(:)
10309  REAL(DP), POINTER :: DUMMY_VALUES2(:)
10310  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
10311 
10312  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NDOFS_TO_PRINT
10313  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION
10314  INTEGER(INTG) :: loop_idx
10315 
10316  enters("FiniteElasticity_PreSolveGetSolidDisplacement",err,error,*999)
10317 
10318 !--- \todo : Do we need for each case a FIELD_PARAMETER_SET_UPDATE_START / FINISH on FIELD_MESH_DISPLACEMENT_SET_TYPE ?
10319 
10320  NULLIFY(solver_finite_elasticity)
10321  NULLIFY(mesh_displacement_values)
10322  NULLIFY(dummy_values2)
10323 
10324  IF(ASSOCIATED(control_loop)) THEN
10325  control_time_loop=>control_loop
10326  DO loop_idx=1,control_loop%CONTROL_LOOP_LEVEL
10327  IF(control_time_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
10328  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
10329  EXIT
10330  ENDIF
10331  IF (ASSOCIATED(control_loop%PARENT_LOOP)) THEN
10332  control_time_loop=>control_time_loop%PARENT_LOOP
10333  ELSE
10334  CALL flagerror("Could not find a time control loop.",err,error,*999)
10335  ENDIF
10336  ENDDO
10337 
10338  IF(ASSOCIATED(solver)) THEN
10339  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
10340  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
10341  CALL flagerror("Problem specification is not allocated.",err,error,*999)
10342  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
10343  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
10344  END IF
10345  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
10346  CASE(problem_standard_elasticity_darcy_subtype,problem_quasistatic_elasticity_transient_darcy_subtype, &
10347  & problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
10348  ! do nothing ???
10349  CASE(problem_pgm_elasticity_darcy_subtype)
10350  !--- Motion: read in from a file
10351  IF(solver%GLOBAL_NUMBER==1) THEN
10352  CALL solvers_solver_get(solver%SOLVERS,1,solver_finite_elasticity,err,error,*999)
10353  solver_equations_finite_elasticity=>solver_finite_elasticity%SOLVER_EQUATIONS
10354  IF(ASSOCIATED(solver_equations_finite_elasticity)) THEN
10355  solver_mapping_finite_elasticity=>solver_equations_finite_elasticity%SOLVER_MAPPING
10356  IF(ASSOCIATED(solver_mapping_finite_elasticity)) THEN
10357  equations_set_finite_elasticity=>solver_mapping_finite_elasticity%EQUATIONS_SETS(1)%PTR
10358  IF(ASSOCIATED(equations_set_finite_elasticity)) THEN
10359  dependent_field_finite_elasticity=>equations_set_finite_elasticity%DEPENDENT%DEPENDENT_FIELD
10360  ELSE
10361  CALL flagerror("Finite elasticity equations set is not associated.",err,error,*999)
10362  END IF
10363  CALL write_string(general_output_type,"Finite Elasticity motion read from a file ... ",err,error,*999)
10364 
10365  CALL field_number_of_components_get(equations_set_finite_elasticity%GEOMETRY%GEOMETRIC_FIELD, &
10366  & field_u_variable_type,number_of_dimensions,err,error,*999)
10367 
10368  !Copy input to Finite elasticity's dependent field
10369  !\todo: Still need to take into account that we are reading in displacement,
10370  ! while dependent field is the absolute position of the structure
10371  input_type=42
10372  input_option=2
10373  CALL field_parameter_set_data_get(equations_set_finite_elasticity%DEPENDENT%DEPENDENT_FIELD, &
10374  & field_u_variable_type,field_values_set_type,mesh_displacement_values,err,error,*999)
10375  CALL fluid_mechanics_io_read_data(solver_linear_type,mesh_displacement_values, &
10376  & number_of_dimensions,input_type,input_option,control_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
10377  CALL field_parameter_set_update_start(equations_set_finite_elasticity%DEPENDENT%DEPENDENT_FIELD, &
10378  & field_u_variable_type,field_values_set_type,err,error,*999)
10379  CALL field_parameter_set_update_finish(equations_set_finite_elasticity%DEPENDENT%DEPENDENT_FIELD, &
10380  & field_u_variable_type,field_values_set_type,err,error,*999)
10381  ELSE
10382  CALL flagerror("Finite elasticity solver mapping is not associated.",err,error,*999)
10383  END IF
10384  ELSE
10385  CALL flagerror("Finite elasticity solver equations are not associated.",err,error,*999)
10386  END IF
10387 
10388  IF(diagnostics1) THEN
10389  ndofs_to_print = SIZE(mesh_displacement_values,1)
10390  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print,ndofs_to_print,&
10391  & mesh_displacement_values,'(" MESH_DISPLACEMENT_VALUES = ",4(X,E13.6))','4(4(X,E13.6))', &
10392  & err,error,*999)
10393  ENDIF
10394  ELSE
10395  ! in case of a solver number different from 3: do nothing ???
10396  ENDIF
10397  CASE DEFAULT
10398  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
10399  & " is not valid for a Finite elasticity equation fluid type of a fluid mechanics problem class."
10400  CALL flagerror(local_error,err,error,*999)
10401  END SELECT
10402  ELSE
10403  CALL flagerror("Problem is not associated.",err,error,*999)
10404  ENDIF
10405  ELSE
10406  CALL flagerror("Solver is not associated.",err,error,*999)
10407  ENDIF
10408  ELSE
10409  CALL flagerror("Control loop is not associated.",err,error,*999)
10410  ENDIF
10411 
10412  exits("FiniteElasticity_PreSolveGetSolidDisplacement")
10413  RETURN
10414 999 errors("FiniteElasticity_PreSolveGetSolidDisplacement",err,error)
10415  exits("FiniteElasticity_PreSolveGetSolidDisplacement")
10416  RETURN 1
10417 
10418  END SUBROUTINE finiteelasticity_presolvegetsoliddisplacement
10419 
10420  !
10421  !================================================================================================================================
10422  !
10423 
10425  SUBROUTINE finiteelasticity_presolveupdateboundaryconditions(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
10426 
10427  !Argument variables
10428  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
10429  TYPE(solver_type), POINTER :: SOLVER
10430  INTEGER(INTG), INTENT(OUT) :: ERR
10431  TYPE(varying_string), INTENT(OUT) :: ERROR
10432  !Local Variables
10433  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
10434  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
10435  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
10436  TYPE(equations_type), POINTER :: EQUATIONS
10437  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
10438  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
10439  TYPE(field_type), POINTER :: DEPENDENT_FIELD, GEOMETRIC_FIELD
10440  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
10441  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
10442  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
10443 
10444  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,ALPHA
10445  REAL(DP), POINTER :: GEOMETRIC_FIELD_VALUES(:)
10446  REAL(DP), POINTER :: MESH_POSITION_VALUES(:)
10447  REAL(DP), POINTER :: DUMMY_VALUES1(:), CURRENT_PRESSURE_VALUES(:)
10448  REAL(DP), ALLOCATABLE :: NEW_PRESSURE_VALUES(:)
10449 
10450  INTEGER(INTG) :: BOUNDARY_CONDITION_CHECK_VARIABLE
10451  INTEGER(INTG) :: dof_number,GEOMETRY_NUMBER_OF_DOFS,DEPENDENT_NUMBER_OF_DOFS
10452  INTEGER(INTG) :: NDOFS_TO_PRINT
10453  INTEGER(INTG) :: loop_idx
10454  INTEGER(INTG) :: SUBITERATION_NUMBER
10455 
10456  enters("FiniteElasticity_PreSolveUpdateBoundaryConditions",err,error,*999)
10457 
10458 
10459  NULLIFY( current_pressure_values, dummy_values1 )
10460 
10461 
10462  IF(ASSOCIATED(control_loop)) THEN
10463  control_time_loop=>control_loop
10464  DO loop_idx=1,control_loop%CONTROL_LOOP_LEVEL
10465  IF(control_time_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
10466  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
10467  EXIT
10468  ENDIF
10469  IF (ASSOCIATED(control_loop%PARENT_LOOP)) THEN
10470  control_time_loop=>control_time_loop%PARENT_LOOP
10471  ELSE
10472  CALL flagerror("Could not find a time control loop.",err,error,*999)
10473  ENDIF
10474  ENDDO
10475  IF(ASSOCIATED(solver)) THEN
10476  IF(solver%GLOBAL_NUMBER==1) THEN
10477  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
10478  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
10479  CALL flagerror("Problem specification is not allocated.",err,error,*999)
10480  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
10481  CALL flagerror("Problem specification must have three entries for a finite elasticity problem.",err,error,*999)
10482  END IF
10483  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
10484  CASE(problem_quasistatic_elasticity_transient_darcy_subtype,problem_quasistatic_elast_trans_darcy_mat_solve_subtype)
10485  solver_equations=>solver%SOLVER_EQUATIONS
10486  IF(ASSOCIATED(solver_equations)) THEN
10487  solver_mapping=>solver_equations%SOLVER_MAPPING
10488  IF(ASSOCIATED(solver_mapping)) THEN
10489  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
10490  IF(ASSOCIATED(equations)) THEN
10491  equations_set=>equations%EQUATIONS_SET
10492  IF(ASSOCIATED(equations_set)) THEN
10493  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
10494  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
10495  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
10496  CALL flagerror("Equations set specification must have three entries for a finite elasticity type "// &
10497  & "equations set.",err,error,*999)
10498  END IF
10499  SELECT CASE(equations_set%SPECIFICATION(3))
10500  CASE(equations_set_incompressible_elasticity_driven_darcy_subtype)
10501  IF(control_loop%sub_loops(1)%ptr%loop_type==problem_control_while_loop_type) THEN
10502  subiteration_number=control_loop%sub_loops(1)%ptr%while_loop%iteration_number
10503  write(*,*)'SUBITERATION_NUMBER = ',subiteration_number
10504  ELSE
10505  CALL flagerror("Could not find SUBITERATION_NUMBER.",err,error,*999)
10506  ENDIF
10507 
10508  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
10509  IF(ASSOCIATED(dependent_field)) THEN
10510  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
10511  IF(ASSOCIATED(boundary_conditions)) THEN
10512  equations_mapping=>equations_set%EQUATIONS%EQUATIONS_MAPPING
10513  IF(ASSOCIATED(equations_mapping)) THEN
10514  CALL field_variable_get(dependent_field,field_deludeln_variable_type,field_variable, &
10515  & err,error,*999)
10516  IF(ASSOCIATED(field_variable)) THEN
10517  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
10518  & boundary_conditions_variable,err,error,*999)
10519  IF(ASSOCIATED(boundary_conditions_variable)) THEN
10520  IF(boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure)>0) THEN
10521  CALL field_parameter_set_data_get(dependent_field,field_deludeln_variable_type, &
10522  & field_pressure_values_set_type,current_pressure_values,err,error,*999)
10523 
10524  IF(diagnostics1) THEN
10525  ndofs_to_print = SIZE(current_pressure_values,1)
10526  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print, &
10527  & ndofs_to_print,current_pressure_values, &
10528  & '(" DEP_FIELD,FIELD_U_VAR_TYPE,FIELD_PRESSURE_VAL_SET_TYPE (before) = ",4(X,E13.6))',&
10529  & '4(4(X,E13.6))',err,error,*999)
10530  CALL field_parameter_set_data_restore(dependent_field,field_deludeln_variable_type, &
10531  & field_pressure_values_set_type,current_pressure_values,err,error,*999)
10532  ENDIF
10533 
10534  dependent_number_of_dofs=dependent_field%VARIABLE_TYPE_MAP(field_deludeln_variable_type)% &
10535  & ptr%NUMBER_OF_DOFS
10536 
10537  ALLOCATE(new_pressure_values(dependent_number_of_dofs))
10538 
10539  !Linear increase of cavity pressure: just a test example prototype
10540  !\todo: general time-dependent boundary condition input method?
10541  alpha = ( current_time + time_increment ) / current_time
10542  new_pressure_values(1:dependent_number_of_dofs) = alpha * &
10543  & current_pressure_values(1:dependent_number_of_dofs)
10544 
10545  CALL write_string(general_output_type,"Finite Elasticity update pressure BCs", &
10546  & err,error,*999)
10547  DO dof_number=1,dependent_number_of_dofs
10548  CALL field_parameter_set_update_local_dof(dependent_field, &
10549  & field_deludeln_variable_type,field_pressure_values_set_type,dof_number, &
10550  & new_pressure_values(dof_number),err,error,*999)
10551  ENDDO
10552  CALL field_parameter_set_update_start(dependent_field, &
10553  & field_deludeln_variable_type, field_pressure_values_set_type,err,error,*999)
10554  CALL field_parameter_set_update_finish(dependent_field, &
10555  & field_deludeln_variable_type, field_pressure_values_set_type,err,error,*999)
10556 
10557  DEALLOCATE(new_pressure_values)
10558 
10559  IF(diagnostics1) THEN
10560  NULLIFY( dummy_values1 )
10561  CALL field_parameter_set_data_get(dependent_field,field_deludeln_variable_type, &
10562  & field_pressure_values_set_type,dummy_values1,err,error,*999)
10563  ndofs_to_print = SIZE(dummy_values1,1)
10564  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print, &
10565  & ndofs_to_print,dummy_values1, &
10566  & '(" DEP_FIELD,FIELD_U_VAR_TYPE,FIELD_PRESSURE_VAL_SET_TYPE (after) = ",4(X,E13.6))', &
10567  & '4(4(X,E13.6))',err,error,*999)
10568  CALL field_parameter_set_data_restore(dependent_field,field_deludeln_variable_type, &
10569  & field_pressure_values_set_type,dummy_values1,err,error,*999)
10570  ENDIF
10571  CALL field_parameter_set_data_restore(dependent_field,field_deludeln_variable_type, &
10572  & field_pressure_values_set_type,current_pressure_values,err,error,*999)
10573  ENDIF !Pressure_condition_used
10574  ELSE
10575  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
10576  END IF
10577  ELSE
10578  CALL flagerror("Dependent field DelUDelN variable is not associated.",err,error,*999)
10579  ENDIF
10580  ELSE
10581  CALL flagerror("EQUATIONS_MAPPING is not associated.",err,error,*999)
10582  ENDIF
10583  ELSE
10584  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
10585  END IF
10586  ELSE
10587  CALL flagerror("Dependent field is not associated.",err,error,*999)
10588  END IF
10589 
10590  CASE DEFAULT
10591  ! do nothing ???
10592 ! LOCAL_ERROR="Equations set subtype " &
10593 ! & //TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",ERR,ERROR))// &
10594 ! & " is not valid for a standard elasticity Darcy problem subtype."
10595 ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
10596  END SELECT
10597  ELSE
10598  CALL flagerror("Equations set is not associated.",err,error,*999)
10599  END IF
10600  ELSE
10601  CALL flagerror("Equations are not associated.",err,error,*999)
10602  END IF
10603  ELSE
10604  CALL flagerror("Solver mapping is not associated.",err,error,*999)
10605  ENDIF
10606  ELSE
10607  CALL flagerror("Solver equations are not associated.",err,error,*999)
10608  END IF
10609 
10610  CASE(problem_standard_elasticity_darcy_subtype)
10611  solver_equations=>solver%SOLVER_EQUATIONS
10612  IF(ASSOCIATED(solver_equations)) THEN
10613  solver_mapping=>solver_equations%SOLVER_MAPPING
10614  IF(ASSOCIATED(solver_mapping)) THEN
10615  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
10616  IF(ASSOCIATED(equations)) THEN
10617  equations_set=>equations%EQUATIONS_SET
10618  IF(ASSOCIATED(equations_set)) THEN
10619  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
10620  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
10621  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
10622  CALL flagerror("Equations set specification must have three entries for a finite elasticity type "// &
10623  & "equations set.",err,error,*999)
10624  END IF
10625  SELECT CASE(equations_set%SPECIFICATION(3))
10626  CASE(equations_set_incompressible_finite_elasticity_darcy_subtype, &
10627  & equations_set_elasticity_darcy_inria_model_subtype, &
10628  & equations_set_incompressible_elasticity_driven_darcy_subtype)
10629  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
10630  CALL write_string(general_output_type,"Finite Elasticity update BCs",err,error,*999)
10631  ENDIF
10632  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
10633  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
10634  IF(ASSOCIATED(dependent_field).AND.ASSOCIATED(geometric_field)) THEN
10635  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
10636  IF(ASSOCIATED(boundary_conditions)) THEN
10637  equations_mapping=>equations_set%EQUATIONS%EQUATIONS_MAPPING
10638  IF(ASSOCIATED(equations_mapping)) THEN
10639  CALL field_variable_get(dependent_field,field_u_variable_type,field_variable,err,error,*999)
10640  IF(ASSOCIATED(field_variable)) THEN
10641  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
10642  & boundary_conditions_variable,err,error,*999)
10643  IF(ASSOCIATED(boundary_conditions_variable)) THEN
10644  IF(diagnostics1) THEN
10645  NULLIFY( dummy_values1 )
10646  CALL field_parameter_set_data_get(dependent_field,field_u_variable_type, &
10647  & field_values_set_type,dummy_values1,err,error,*999)
10648  ndofs_to_print = SIZE(dummy_values1,1)
10649  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print, &
10650  & ndofs_to_print,dummy_values1, &
10651  & '(" DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE (bef) = ",4(X,E13.6))',&
10652  & '4(4(X,E13.6))',err,error,*999)
10653  CALL field_parameter_set_data_restore(dependent_field,field_u_variable_type, &
10654  & field_values_set_type,dummy_values1,err,error,*999)
10655  ENDIF
10656 
10657  ! requires solid dependent field and geometry to be interpolated identically !!!
10658  ! assumes that DOFs for dependent and geometric field are stored in the same order
10659  ! How does this routine take into account the BC value ???
10660  alpha = 0.10_dp * sin( 2.0_dp * pi * current_time / 4.0_dp )
10661  CALL field_parameter_sets_copy(geometric_field,field_u_variable_type, &
10662  & field_values_set_type,field_mesh_displacement_set_type,alpha,err,error,*999)
10663 
10664  NULLIFY(geometric_field_values)
10665  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type, &
10666  & field_values_set_type,geometric_field_values,err,error,*999)
10667 
10668  geometry_number_of_dofs=geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)% &
10669  & ptr%NUMBER_OF_DOFS
10670  DO dof_number=1,geometry_number_of_dofs
10671  boundary_condition_check_variable=boundary_conditions_variable% &
10672  & condition_types(dof_number)
10673  IF(boundary_condition_check_variable==boundary_condition_moved_wall .OR. &
10674  & boundary_condition_check_variable==boundary_condition_moved_wall_incremented) THEN
10675  !--- To obtain absolute positions, add nodal coordinates on top of mesh displacement
10676  CALL field_parameter_set_add_local_dof(geometric_field, &
10677  & field_u_variable_type,field_mesh_displacement_set_type,dof_number, &
10678  & geometric_field_values(dof_number),err,error,*999)
10679  ELSE
10680  ! do nothing ???
10681  END IF
10682  END DO
10683 
10684  NULLIFY(mesh_position_values)
10685  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type, &
10686  & field_mesh_displacement_set_type,mesh_position_values,err,error,*999)
10687 
10688  dependent_number_of_dofs=dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)% &
10689  & ptr%NUMBER_OF_DOFS
10690  DO dof_number=1,dependent_number_of_dofs
10691  boundary_condition_check_variable=boundary_conditions_variable% &
10692  & condition_types(dof_number)
10693  IF(boundary_condition_check_variable==boundary_condition_moved_wall .OR. &
10694  & boundary_condition_check_variable==boundary_condition_moved_wall_incremented) THEN
10695 
10696 !---tob
10697  !Update FIELD_BOUNDARY_CONDITIONS_SET_TYPE or FIELD_VALUES_SET_TYPE
10698  !(so it is one or the other, but not both) depending on whether or not load increments are used
10699  IF(boundary_condition_check_variable==boundary_condition_moved_wall_incremented) THEN
10700  CALL field_parameter_set_update_local_dof(dependent_field, &
10701  & field_u_variable_type,field_boundary_conditions_set_type,dof_number, &
10702  & mesh_position_values(dof_number),err,error,*999)
10703  ELSE
10704  !--- Update the dependent field with the new absolute position
10705  CALL field_parameter_set_update_local_dof(dependent_field, &
10706  & field_u_variable_type,field_values_set_type,dof_number, &
10707  & mesh_position_values(dof_number),err,error,*999)
10708  ENDIF
10709 !---toe
10710 
10711  ELSE
10712  ! do nothing ???
10713  END IF
10714  END DO
10715 
10716  IF(boundary_condition_check_variable==boundary_condition_moved_wall_incremented) THEN
10717  CALL field_parameter_set_update_start(dependent_field, &
10718  & field_u_variable_type, field_boundary_conditions_set_type,err,error,*999)
10719  CALL field_parameter_set_update_finish(dependent_field, &
10720  & field_u_variable_type, field_boundary_conditions_set_type,err,error,*999)
10721  ELSE
10722  CALL field_parameter_set_update_start(dependent_field, &
10723  & field_u_variable_type, field_values_set_type,err,error,*999)
10724  CALL field_parameter_set_update_finish(dependent_field, &
10725  & field_u_variable_type, field_values_set_type,err,error,*999)
10726  ENDIF
10727 
10728  IF(diagnostics1) THEN
10729  NULLIFY( dummy_values1 )
10730  CALL field_parameter_set_data_get(dependent_field,field_u_variable_type, &
10731  & field_values_set_type,dummy_values1,err,error,*999)
10732  ndofs_to_print = SIZE(dummy_values1,1)
10733  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print, &
10734  & ndofs_to_print,dummy_values1, &
10735  & '(" DEPENDENT_FIELD,FIELD_U_VAR_TYPE,FIELD_VALUES_SET_TYPE (after) = ",4(X,E13.6))', &
10736  & '4(4(X,E13.6))',err,error,*999)
10737  CALL field_parameter_set_data_restore(dependent_field,field_u_variable_type, &
10738  & field_values_set_type,dummy_values1,err,error,*999)
10739  ENDIF
10740  ELSE
10741  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
10742  END IF
10743  CALL field_parameter_set_update_start(dependent_field,field_u_variable_type, &
10744  & field_values_set_type,err,error,*999)
10745  CALL field_parameter_set_update_finish(dependent_field,field_u_variable_type, &
10746  & field_values_set_type,err,error,*999)
10747  ELSE
10748  CALL flagerror("Dependent field U variable is not associated.",err,error,*999)
10749  ENDIF
10750  ELSE
10751  CALL flagerror("EQUATIONS_MAPPING is not associated.",err,error,*999)
10752  ENDIF
10753  ELSE
10754  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
10755  END IF
10756  ELSE
10757  CALL flagerror("Dependent field and/or geometric field is/are not associated.",err,error,*999)
10758  END IF
10759  CASE DEFAULT
10760  ! do nothing ???
10761 ! LOCAL_ERROR="Equations set subtype " &
10762 ! & //TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",ERR,ERROR))// &
10763 ! & " is not valid for a standard elasticity Darcy problem subtype."
10764 ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
10765  END SELECT
10766  ELSE
10767  CALL flagerror("Equations set is not associated.",err,error,*999)
10768  END IF
10769  ELSE
10770  CALL flagerror("Equations are not associated.",err,error,*999)
10771  END IF
10772  ELSE
10773  CALL flagerror("Solver mapping is not associated.",err,error,*999)
10774  ENDIF
10775  ELSE
10776  CALL flagerror("Solver equations are not associated.",err,error,*999)
10777  END IF
10778  CASE DEFAULT
10779  ! do nothing ???
10780 ! LOCAL_ERROR="Problem subtype "//TRIM(NUMBER_TO_VSTRING(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",ERR,ERROR))// &
10781 ! & " is not valid for this problem class."
10782 ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
10783  END SELECT
10784  ELSE
10785  CALL flagerror("Problem is not associated.",err,error,*999)
10786  ENDIF
10787  ELSE
10788  ! do nothing ???
10789 ! CALL FlagError("PRE_SOLVE_UPDATE_BOUNDARY_CONDITIONS may only be carried out for SOLVER%GLOBAL_NUMBER = 1", &
10790 ! & ERR,ERROR,*999)
10791  ENDIF
10792  ELSE
10793  CALL flagerror("Solver is not associated.",err,error,*999)
10794  ENDIF
10795  ELSE
10796  CALL flagerror("Control loop is not associated.",err,error,*999)
10797  ENDIF
10798 
10799  exits("FiniteElasticity_PreSolveUpdateBoundaryConditions")
10800  RETURN
10801 999 errors("FiniteElasticity_PreSolveUpdateBoundaryConditions",err,error)
10802  exits("FiniteElasticity_PreSolveUpdateBoundaryConditions")
10803  RETURN 1
10804 
10805  END SUBROUTINE finiteelasticity_presolveupdateboundaryconditions
10806 
10807  !
10808  !================================================================================================================================
10809  !
10810 
10813  SUBROUTINE evaluate_chapelle_function(Jznu,ffact,dfdJfact,ERR,ERROR,*)
10814 
10815  !Argument variables
10816  REAL(DP), INTENT(IN) :: Jznu
10817  REAL(DP), INTENT(OUT) :: ffact
10818  REAL(DP), INTENT(OUT) :: dfdJfact
10819  INTEGER(INTG), INTENT(OUT) :: ERR
10820  TYPE(varying_string), INTENT(OUT) :: ERROR
10821 
10822  enters("EVALUATE_CHAPELLE_FUNCTION",err,error,*999)
10823 
10824 ! IF( ABS(Jznu-1.0_DP) > 5.0E-02_DP ) THEN
10825  IF( abs(jznu-1.0_dp) > 1.0e-10_dp ) THEN
10826  !Eq.(21) of the INRIA paper
10827  ffact = 2.0_dp * (jznu - 1.0_dp - log(jznu)) / (jznu - 1.0_dp)**2.0_dp
10828  dfdjfact = ( 2.0_dp * (1.0_dp - 1.0_dp/jznu) * (jznu - 1.0_dp)**2.0_dp &
10829  & - 4.0_dp * (jznu - 1.0_dp - log(jznu)) * (jznu - 1.0_dp) ) / (jznu - 1.0_dp)**4.0_dp
10830  ELSE
10831  ffact = 1.0_dp
10832  dfdjfact = 0.0_dp
10833  END IF
10834 
10835  exits("EVALUATE_CHAPELLE_FUNCTION")
10836  RETURN
10837 999 errorsexits("EVALUATE_CHAPELLE_FUNCTION",err,error)
10838  RETURN 1
10839  END SUBROUTINE evaluate_chapelle_function
10840 
10841  !
10842  !================================================================================================================================
10843  !
10844 
10847  SUBROUTINE evaluate_chapelle_piola_tensor_addition(AZL,AZU,DARCY_MASS_INCREASE,PIOLA_TENSOR_ADDITION,ERR,ERROR,*)
10848 
10849  !Argument variables
10850  REAL(DP), INTENT(IN) :: AZL(3,3)
10851  REAL(DP), INTENT(IN) :: AZU(3,3)
10852  REAL(DP), INTENT(IN) :: DARCY_MASS_INCREASE
10853  REAL(DP), INTENT(OUT) :: PIOLA_TENSOR_ADDITION(3,3)
10854  INTEGER(INTG), INTENT(OUT) :: ERR
10855  TYPE(varying_string), INTENT(OUT) :: ERROR
10856  !Local variables
10857  REAL(DP) :: Jznu
10858  REAL(DP) :: ffact
10859  REAL(DP) :: dfdJfact
10860  REAL(DP) :: Mfact, bfact, p0fact
10861  REAL(DP) :: DARCY_VOL_INCREASE, DARCY_RHO_0_F
10862  INTEGER(INTG) :: i,j
10863 
10864 
10865  enters("EVALUATE_CHAPELLE_PIOLA_TENSOR_ADDITION",err,error,*999)
10866 
10867  !Parameters settings for coupled elasticity Darcy INRIA model:
10868  CALL get_darcy_finite_elasticity_parameters(darcy_rho_0_f,mfact,bfact,p0fact,err,error,*999)
10869 
10870  darcy_vol_increase = darcy_mass_increase / darcy_rho_0_f
10871 
10872  jznu=determinant(azl,err,error)**0.5_dp
10873  IF( abs(jznu) < 1.0e-10_dp ) THEN
10874  CALL flagerror("EVALUATE_CHAPELLE_PIOLA_TENSOR_ADDITION: ABS(Jznu) < 1.0E-10_DP",err,error,*999)
10875  END IF
10876 
10877  CALL evaluate_chapelle_function(jznu,ffact,dfdjfact,err,error,*999)
10878 
10879  DO i=1,3
10880  DO j=1,3
10881 ! PIOLA_TENSOR_ADDITION(i,j) = - Mfact * bfact * DARCY_VOL_INCREASE * (ffact + (Jznu - 1.0_DP) * dfdJfact) * Jznu * AZU(i,j) &
10882 ! & + 0.5_DP * Mfact * DARCY_VOL_INCREASE**2.0_DP * dfdJfact * Jznu * AZU(i,j)
10883  piola_tensor_addition(i,j) = 0.5_dp * mfact * darcy_vol_increase**2.0_dp * jznu * azu(i,j)
10884 ! PIOLA_TENSOR_ADDITION(i,j) = 0.0_DP
10885  ENDDO
10886  ENDDO
10887 
10888 ! PIOLA_TENSOR_ADDITION = - Mfact * bfact * DARCY_VOL_INCREASE * (ffact + (Jznu - 1.0_DP) * dfdJfact) * Jznu * AZU &
10889 ! & + 0.5_DP * Mfact * DARCY_VOL_INCREASE**2.0_DP * dfdJfact * Jznu * AZU
10890 
10891  IF(diagnostics1) THEN
10892  CALL write_string_value(diagnostic_output_type," DARCY_VOL_INCREASE = ",darcy_vol_increase,err,error,*999)
10893  CALL write_string_value(diagnostic_output_type," Jznu = ",jznu,err,error,*999)
10894  CALL write_string_value(diagnostic_output_type," ffact = ",ffact,err,error,*999)
10895  CALL write_string_value(diagnostic_output_type," dfdJfact = ",dfdjfact,err,error,*999)
10896  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
10897  & 3,3,azu,write_string_matrix_name_and_indices,'(" AZU','(",I1,",:)',' :",3(X,E13.6))', &
10898  & '(17X,3(X,E13.6))',err,error,*999)
10899  CALL write_string_matrix(diagnostic_output_type,1,1,3,1,1,3, &
10900  & 3,3,piola_tensor_addition, &
10901  & write_string_matrix_name_and_indices,'(" PIOLA_TENSOR_ADDITION','(",I1,",:)',' :",3(X,E13.6))', &
10902  & '(17X,3(X,E13.6))',err,error,*999)
10903  ENDIF
10904 
10905  exits("EVALUATE_CHAPELLE_PIOLA_TENSOR_ADDITION")
10906  RETURN
10907 999 errorsexits("EVALUATE_CHAPELLE_PIOLA_TENSOR_ADDITION",err,error)
10908  RETURN 1
10909  END SUBROUTINE evaluate_chapelle_piola_tensor_addition
10910 
10911  !
10912  !================================================================================================================================
10913  !
10914 
10916  SUBROUTINE get_darcy_finite_elasticity_parameters(DARCY_RHO_0_F,Mfact,bfact,p0fact,ERR,ERROR,*)
10917 
10918  !Argument variables
10919  REAL(DP), INTENT(OUT) :: DARCY_RHO_0_F
10920  REAL(DP), INTENT(OUT) :: Mfact
10921  REAL(DP), INTENT(OUT) :: bfact
10922  REAL(DP), INTENT(OUT) :: p0fact
10923  INTEGER(INTG), INTENT(OUT) :: ERR
10924  TYPE(varying_string), INTENT(OUT) :: ERROR
10925 
10926  enters("GET_DARCY_FINITE_ELASTICITY_PARAMETERS",err,error,*999)
10927 
10928 ! DARCY_RHO_0_F = 1.0E-03_DP
10929  darcy_rho_0_f = 1.0_dp
10930 ! Mfact = 2.18E05_DP
10931  mfact = 2.18e00_dp
10932  bfact = 1.0_dp
10933  p0fact = 0.0_dp
10934 
10935  exits("GET_DARCY_FINITE_ELASTICITY_PARAMETERS")
10936  RETURN
10937 999 errorsexits("GET_DARCY_FINITE_ELASTICITY_PARAMETERS",err,error)
10938  RETURN 1
10939  END SUBROUTINE get_darcy_finite_elasticity_parameters
10940 
10941  !
10942  !================================================================================================================================
10943  !
10944 
10946  SUBROUTINE finite_elasticity_load_increment_apply(EQUATIONS_SET,ITERATION_NUMBER,MAXIMUM_NUMBER_OF_ITERATIONS,ERR,ERROR,*)
10947 
10948  !Argument variables
10949  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
10950  INTEGER(INTG), INTENT(IN) :: ITERATION_NUMBER
10951  INTEGER(INTG), INTENT(IN) :: MAXIMUM_NUMBER_OF_ITERATIONS
10952  INTEGER(INTG), INTENT(OUT) :: ERR
10953  TYPE(varying_string), INTENT(OUT) :: ERROR
10954 
10955  !Local variables
10956  TYPE(equations_type), POINTER :: EQUATIONS
10957  TYPE(field_type), POINTER :: SOURCE_FIELD
10958  REAL(DP) :: INCREMENT
10959 
10960  enters("FINITE_ELASTICITY_LOAD_INCREMENT_APPLY",err,error,*999)
10961 
10962  IF(ASSOCIATED(equations_set)) THEN
10963  equations=>equations_set%EQUATIONS
10964  IF(ASSOCIATED(equations)) THEN
10965  source_field=>equations%INTERPOLATION%SOURCE_FIELD
10966  IF(ASSOCIATED(source_field)) THEN
10967  IF(maximum_number_of_iterations>1) THEN
10968  IF(iteration_number==1) THEN
10969  !Setup initial values parameter set
10970  CALL field_parametersetensurecreated(source_field,field_u_variable_type,field_initial_values_set_type,err,error,*999)
10971  CALL field_parameter_sets_copy(source_field,field_u_variable_type,field_values_set_type, &
10972  & field_initial_values_set_type,1.0_dp,err,error,*999)
10973  ENDIF
10974  increment=REAL(iteration_number)/REAL(maximum_number_of_iterations)
10975  CALL field_parameter_sets_copy(source_field,field_u_variable_type,field_initial_values_set_type, &
10976  & field_values_set_type,increment,err,error,*999)
10977  ENDIF
10978  ENDIF
10979  ELSE
10980  CALL flagerror("Equations set equations is not associated.",err,error,*999)
10981  ENDIF
10982  ELSE
10983  CALL flagerror("Equations set is not associated.",err,error,*999)
10984  ENDIF
10985 
10986  exits("FINITE_ELASTICITY_LOAD_INCREMENT_APPLY")
10987  RETURN
10988 999 errorsexits("FINITE_ELASTICITY_LOAD_INCREMENT_APPLY",err,error)
10989  RETURN 1
10990 
10991  END SUBROUTINE finite_elasticity_load_increment_apply
10992 
10993  !
10994  !================================================================================================================================
10995  !
10996 
10997 END MODULE finite_elasticity_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
finite_elasticity_routines::finite_elasticity_equations_set_setup
subroutine, public finite_elasticity_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the finite elasticity equation type of an elasticity equations set class. ...
Definition: finite_elasticity_routines.f90:5761
finite_elasticity_routines::finite_elasticity_cylinder_analytic_func_evaluate
real(dp) function finite_elasticity_cylinder_analytic_func_evaluate(MU1, PIN, POUT, LAMBDA, TSI, A1, A2, C1, C2)
Evaluates the residual function required to solve for MU1, in the cylinder analytic example...
Definition: finite_elasticity_routines.f90:593
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
equations_set_constants::equations_set_evaluate_second_pk_stress_tensor
integer(intg), parameter equations_set_evaluate_second_pk_stress_tensor
Second Piola Kirchhoff stress tensor.
Definition: equations_set_constants.f90:402
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
finite_elasticity_routines::finite_elasticity_post_solve
subroutine, public finite_elasticity_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the finite elasticity problem post solve.
Definition: finite_elasticity_routines.f90:9326
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
maths::invert
Returns the inverse of a matrix.
Definition: maths.f90:131
equations_set_constants::equations_set_transverse_isotropic_exponential_subtype
integer(intg), parameter equations_set_transverse_isotropic_exponential_subtype
Definition: equations_set_constants.f90:123
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
solver_routines::solver_nonlinear_divergence_exit
subroutine, public solver_nonlinear_divergence_exit(SOLVER, ERR, ERROR,)
Instead of warning on nonlinear divergence, exit with error.
Definition: solver_routines.f90:20164
equations_set_constants::equations_set_holzapfel_ogden_activecontraction_subtype
integer(intg), parameter equations_set_holzapfel_ogden_activecontraction_subtype
Definition: equations_set_constants.f90:151
boundary_conditions_routines::boundary_condition_moved_wall_incremented
integer(intg), parameter, public boundary_condition_moved_wall_incremented
The dof is fixed as a boundary condition, to be used with load increment loop.
Definition: boundary_condition_routines.f90:109
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
finite_elasticity_routines::finite_elasticity_post_solve_output_data
subroutine, public finite_elasticity_post_solve_output_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the finite elasticity problem post solve output data.
Definition: finite_elasticity_routines.f90:9407
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
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
equations_set_constants::equations_set_membrane_subtype
integer(intg), parameter equations_set_membrane_subtype
Definition: equations_set_constants.f90:127
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
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
fluid_mechanics_io_routines::numberofdimensions
integer(intg) numberofdimensions
Definition: fluid_mechanics_IO_routines.f90:185
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
problem_constants::problem_multiscale_finite_elasticity_subtype
integer(intg), parameter problem_multiscale_finite_elasticity_subtype
Definition: problem_constants.f90:119
problem_constants::problem_no_subtype
integer(intg), parameter problem_no_subtype
Definition: problem_constants.f90:113
finite_elasticity_routines::finiteelasticity_surfacepressureresidualevaluate
subroutine finiteelasticity_surfacepressureresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, var1, var2, ERR, ERROR,)
Definition: finite_elasticity_routines.f90:3441
equations_set_constants::equations_set_standard_monodomain_elasticity_subtype
integer(intg), parameter equations_set_standard_monodomain_elasticity_subtype
Definition: equations_set_constants.f90:309
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
equations_set_constants::equations_set_constitutive_and_growth_law_in_cellml_subtype
integer(intg), parameter equations_set_constitutive_and_growth_law_in_cellml_subtype
Definition: equations_set_constants.f90:153
problem_constants::problem_fe_contact_reproject_subtype
integer(intg), parameter problem_fe_contact_reproject_subtype
Definition: problem_constants.f90:128
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
equations_set_constants::equations_set_finite_elasticity_cylinder
integer(intg), parameter equations_set_finite_elasticity_cylinder
Definition: equations_set_constants.f90:483
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
equations_set_constants::equations_set_anisotropic_polynomial_subtype
integer(intg), parameter equations_set_anisotropic_polynomial_subtype
Definition: equations_set_constants.f90:149
equations_set_constants::equations_set_multi_compartment_darcy_subtype
integer(intg), parameter equations_set_multi_compartment_darcy_subtype
Definition: equations_set_constants.f90:193
coordinate_routines::coordinate_jacobian_area_type
integer(intg), parameter, public coordinate_jacobian_area_type
Area type Jacobian.
Definition: coordinate_routines.f90:93
problem_constants::problem_quasistatic_finite_elasticity_subtype
integer(intg), parameter problem_quasistatic_finite_elasticity_subtype
Definition: problem_constants.f90:117
fluid_mechanics_io_routines::source_interpolated_point
type(field_interpolated_point_ptr_type), dimension(:), pointer source_interpolated_point
Definition: fluid_mechanics_IO_routines.f90:179
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
types::domain_topology_type
Contains the topology information for a domain.
Definition: types.f90:724
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_lambda_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_lambda_idx
Lambda parameter index.
Definition: finite_elasticity_routines.f90:98
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
problem_constants::problem_monodomain_elasticity_w_titin_subtype
integer(intg), parameter problem_monodomain_elasticity_w_titin_subtype
Definition: problem_constants.f90:253
input_output::writestringmatrix
Write a string followed by a matrix to a specified output stream.
Definition: input_output.f90:335
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
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
finite_elasticity_routines::finiteelasticity_straincalculate
subroutine, public finiteelasticity_straincalculate(equationsSet, strainField, strainFieldVariableType, err, error,)
Calculates the strain field for a finite elasticity finite element equations set. ...
Definition: finite_elasticity_routines.f90:2763
finite_elasticity_routines::finiteelasticity_equationssetsolutionmethodset
subroutine, public finiteelasticity_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a finite elasticity equation type of an elasticity equations set...
Definition: finite_elasticity_routines.f90:8461
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_standard_elasticity_darcy_subtype
integer(intg), parameter equations_set_standard_elasticity_darcy_subtype
Definition: equations_set_constants.f90:307
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
types::fields_type
Contains information on the fields defined on a region.
Definition: types.f90:1373
equations_set_constants::equations_set_no_subtype
integer(intg), parameter equations_set_no_subtype
Definition: equations_set_constants.f90:111
finite_elasticity_routines::finite_elasticity_push_elasticity_tensor
subroutine finite_elasticity_push_elasticity_tensor(ELASTICITY_TENSOR, DZDNU, Jznu, ERR, ERROR,)
Push-forward the rank 4 elasticity tensor.
Definition: finite_elasticity_routines.f90:1226
finite_elasticity_routines::finiteelasticity_tensorinterpolatexi
subroutine, public finiteelasticity_tensorinterpolatexi(equationsSet, tensorEvaluateType, userElementNumber, xi, values, err, error,)
Evaluates a tensor at a given element xi location.
Definition: finite_elasticity_routines.f90:3033
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
fluid_mechanics_io_routines::source_field
type(field_type), pointer source_field
Definition: fluid_mechanics_IO_routines.f90:174
base_routines::flagwarning
Flags a warning to the user.
Definition: base_routines.f90:246
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
equations_routines::equations_derivedvariableget
subroutine, public equations_derivedvariableget(equations, derivedType, fieldVariable, err, error,)
Gets the field variable for the derived variable type.
Definition: equations_routines.f90:935
equations_set_constants::equations_set_transverse_isotropic_guccione_subtype
integer(intg), parameter equations_set_transverse_isotropic_guccione_subtype
Definition: equations_set_constants.f90:135
finite_elasticity_routines::finite_elasticity_gauss_stress_tensor
subroutine finite_elasticity_gauss_stress_tensor(EQUATIONS_SET, DEPENDENT_INTERPOLATED_POINT, MATERIALS_INTERPOLATED_POINT, STRESS_TENSOR, DZDNU, Jznu, ELEMENT_NUMBER, GAUSS_POINT_NUMBER, ERR, ERROR,)
Evaluates the Cauchy stress tensor at a given Gauss point.
Definition: finite_elasticity_routines.f90:5454
equations_set_constants::equations_set_active_strain_subtype
integer(intg), parameter equations_set_active_strain_subtype
Definition: equations_set_constants.f90:154
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
finite_elasticity_routines::finiteelasticity_piolaaddactivecontraction
subroutine finiteelasticity_piolaaddactivecontraction(INDEPENDENT_FIELD, MATERIALS_FIELD, PIOLA_FF, E_FF, ELEMENT_NUMBER, GAUSS_POINT_NUMBER, ERR, ERROR,)
Definition: finite_elasticity_routines.f90:5574
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
boundary_conditions_routines::boundary_condition_pressure_incremented
integer(intg), parameter, public boundary_condition_pressure_incremented
The dof is a surface pressure boundary condition, to be used with load increment loop.
Definition: boundary_condition_routines.f90:108
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
finite_elasticity_routines::finiteelasticity_gaussgrowthtensor_newer123
subroutine finiteelasticity_gaussgrowthtensor_newer123(equationsSet, numberOfDimensions, gaussPointNumber, elementNumber, dependentField, deformationGradientTensor, growthTensor, elasticDeformationGradientTensor, Jg, Je, err, error,)
Evaluates the growth tensor at a given Gauss point and calculates the elastic part of the deformation...
Definition: finite_elasticity_routines.f90:5320
equations_set_constants::equations_set_incompressible_elasticity_driven_mr_subtype
integer(intg), parameter equations_set_incompressible_elasticity_driven_mr_subtype
Definition: equations_set_constants.f90:133
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
fluid_mechanics_io_routines::fluid_mechanics_io_write_cmgui
subroutine, public fluid_mechanics_io_write_cmgui(REGION, EQUATIONS_SET_GLOBAL_NUMBER, NAME, ERR, ERROR,)
Writes solution into cmgui formats exelem and exnode.
Definition: fluid_mechanics_IO_routines.f90:303
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
equations_set_constants::equations_set_elasticity_fluid_pressure_holmes_mow_subtype
integer(intg), parameter equations_set_elasticity_fluid_pressure_holmes_mow_subtype
Definition: equations_set_constants.f90:139
equations_routines::equations_timing_output
integer(intg), parameter, public equations_timing_output
Timing information output.
Definition: equations_routines.f90:69
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
maths::normalise
Normalises a vector.
Definition: maths.f90:221
finite_elasticity_routines::finiteelasticity_boundaryconditionsanalyticcalculate
subroutine, public finiteelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
Definition: finite_elasticity_routines.f90:140
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
input_output::write_string_matrix
Write a string followed by a matrix to a specified output stream.
Definition: input_output.f90:326
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_1d3d_monodomain_elasticity_subtype
integer(intg), parameter equations_set_1d3d_monodomain_elasticity_subtype
Definition: equations_set_constants.f90:310
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
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
finite_elasticity_routines::finiteelasticity_presolveupdateboundaryconditions
subroutine finiteelasticity_presolveupdateboundaryconditions(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update boundary conditions for finite elasticity pre solve.
Definition: finite_elasticity_routines.f90:10426
finite_elasticity_routines::finiteelasticity_finiteelementpostresidualevaluate
subroutine, public finiteelasticity_finiteelementpostresidualevaluate(EQUATIONS_SET, ERR, ERROR,)
Post-evaluates the residual for a finite elasticity finite element equations set. ...
Definition: finite_elasticity_routines.f90:2643
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
equations_set_constants::equations_set_anisotropic_polynomial_active_subtype
integer(intg), parameter equations_set_anisotropic_polynomial_active_subtype
Definition: equations_set_constants.f90:150
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
equations_set_constants::equations_set_evaluate_deformation_gradient_tensor
integer(intg), parameter equations_set_evaluate_deformation_gradient_tensor
Deformation gradient tensor.
Definition: equations_set_constants.f90:398
constants::other_xi_orientations3
integer(intg), dimension(3, 3) other_xi_orientations3
OTHER_XI_ORIENTATIONSS3(ni,nii) gives the orientation of the given two xi directions. Is equal to leviCivita(ni,nii,OTHER_XI_DIRECTIONS3(ni,nii,2)) where leviCivita is the Levi-Civita or alternating symbol.
Definition: constants.f90:280
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
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
fluid_mechanics_io_routines::element_number
integer(intg) element_number
Definition: fluid_mechanics_IO_routines.f90:197
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_pout_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_pout_idx
Outer pressure parameter index.
Definition: finite_elasticity_routines.f90:97
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
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
timer::user_cpu
integer(intg), parameter, public user_cpu
User CPU time type.
Definition: timer_f.f90:68
maths::cross_product
Calculates the vector cross product of two vectors.
Definition: maths.f90:66
equations_set_constants::equations_set_number_of_derived_types
integer(intg), parameter equations_set_number_of_derived_types
Definition: equations_set_constants.f90:391
equations_set_constants::equations_set_mooney_rivlin_activecontraction_subtype
integer(intg), parameter equations_set_mooney_rivlin_activecontraction_subtype
Definition: equations_set_constants.f90:144
finite_elasticity_routines::finiteelasticity_gaussgrowthtensor
subroutine finiteelasticity_gaussgrowthtensor(equationsSet, numberOfDimensions, gaussPointNumber, elementNumber, dependentField, deformationGradientTensor, growthTensor, elasticDeformationGradientTensor, Jg, Je, err, error,)
Evaluates the growth tensor at a given Gauss point and calculates the elastic part of the deformation...
Definition: finite_elasticity_routines.f90:1305
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
maths::matrixproducttranspose
Calculates and returns the matrix-product-transpose A*B^T in the matrix C.
Definition: maths.f90:185
types::decomposition_face_type
Contains the information for a face in a decomposition.
Definition: types.f90:979
maths::i1
Calculates the modified Bessel function of the first kind of order 1 using the approximation of Abrom...
Definition: maths.f90:125
problem_constants::problem_finite_elasticity_type
integer(intg), parameter problem_finite_elasticity_type
Definition: problem_constants.f90:69
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
types::field_interpolated_point_metrics_type
Contains the interpolated point coordinate metrics. Old CMISS name GL,GU,RG.
Definition: types.f90:1112
problem_constants::problem_monodomain_elasticity_velocity_subtype
integer(intg), parameter problem_monodomain_elasticity_velocity_subtype
Definition: problem_constants.f90:254
equations_set_constants::equations_set_setup_derived_type
integer(intg), parameter equations_set_setup_derived_type
Derived field setup.
Definition: equations_set_constants.f90:331
types::problem_setup_type
Definition: types.f90:3215
equations_set_constants::equations_set_incompressible_elast_multi_comp_darcy_subtype
integer(intg), parameter equations_set_incompressible_elast_multi_comp_darcy_subtype
Definition: equations_set_constants.f90:134
finite_elasticity_routines::finiteelasticity_straintensor
subroutine finiteelasticity_straintensor(deformationGradientTensor, rightCauchyDeformationTensor, fingerDeformationTensor, Jacobian, greenStrainTensor, err, error,)
Evaluates the strain tensor given the deformation gradient tensor.
Definition: finite_elasticity_routines.f90:1365
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
finite_elasticity_routines::finite_elasticity_gauss_elasticity_tensor
subroutine finite_elasticity_gauss_elasticity_tensor(EQUATIONS_SET, DEPENDENT_INTERPOLATED_POINT, MATERIALS_INTERPOLATED_POINT, ELASTICITY_TENSOR, HYDRO_ELASTICITY_VOIGT, STRESS_TENSOR, DZDNU, Jznu, ELEMENT_NUMBER, GAUSS_POINT_NUMBER, ERR, ERROR,)
Evaluates the spatial elasticity and stress tensor in Voigt form at a given Gauss point...
Definition: finite_elasticity_routines.f90:619
finite_elasticity_routines::finite_elasticity_fmm
subroutine finite_elasticity_fmm(TIME, DT, PREV_LAMBDA, CURR_LAMBDA, Q123, ISO_TA, TA)
Definition: finite_elasticity_routines.f90:5642
fluid_mechanics_io_routines::source_interpolation_parameters
type(field_interpolation_parameters_ptr_type), dimension(:), pointer source_interpolation_parameters
Definition: fluid_mechanics_IO_routines.f90:178
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
constants::tensor_to_voigt3
integer(intg), dimension(3, 3), parameter tensor_to_voigt3
Definition: constants.f90:286
problem_constants::solver_equations_quasistatic
integer(intg), parameter solver_equations_quasistatic
Solver equations are quasistatic.
Definition: problem_constants.f90:310
finite_elasticity_routines::finite_elasticity_gauss_cauchy_tensor
subroutine finite_elasticity_gauss_cauchy_tensor(EQUATIONS_SET, DEPENDENT_INTERPOLATED_POINT, MATERIALS_INTERPOLATED_POINT, DARCY_DEPENDENT_INTERPOLATED_POINT, INDEPENDENT_INTERPOLATED_POINT, CAUCHY_TENSOR, Jznu, DZDNU, ELEMENT_NUMBER, GAUSS_POINT_NUMBER, ERR, ERROR,)
Evaluates the Cauchy stress tensor at a given Gauss point.
Definition: finite_elasticity_routines.f90:3659
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_rout_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_rout_idx
Outer radius parameter index.
Definition: finite_elasticity_routines.f90:101
coordinate_routines::coordinates_materialsystemcalculate
subroutine, public coordinates_materialsystemcalculate(geometricInterpPointMetrics, fibreInterpPoint, dNudX, dXdNu, dNudXi, dXidNu, err, error,)
Calculates the tensor to get from material coordinate system, nu, to local coordinate system...
Definition: coordinate_routines.f90:3885
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
kinds::dp
integer, parameter dp
Double precision real kind.
Definition: kinds.f90:68
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
finite_elasticity_routines::finiteelasticity_contactproblemspecificationset
subroutine, public finiteelasticity_contactproblemspecificationset(problem, problemSpecification, err, error,)
Sets/changes the problem subtype for a finite elasticity contact type .
Definition: finite_elasticity_routines.f90:9266
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
types::decomposition_topology_type
Contains the topology information for a decomposition.
Definition: types.f90:1054
problem_constants::problem_quasistatic_elasticity_transient_darcy_subtype
integer(intg), parameter problem_quasistatic_elasticity_transient_darcy_subtype
Definition: problem_constants.f90:242
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
problem_constants::problem_fe_contact_transform_reproject_subtype
integer(intg), parameter problem_fe_contact_transform_reproject_subtype
Definition: problem_constants.f90:126
equations_set_constants::equations_set_evaluate_r_cauchy_green_deformation_tensor
integer(intg), parameter equations_set_evaluate_r_cauchy_green_deformation_tensor
Right Cauchy-Green deformation field.
Definition: equations_set_constants.f90:399
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
equations_set_constants::equations_set_elasticity_class
integer(intg), parameter equations_set_elasticity_class
Definition: equations_set_constants.f90:54
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::other_xi_directions3
integer(intg), dimension(3, 3, 2) other_xi_directions3
OTHER_XI_DIRECTIONS3(ni,nii,type) gives the other xi directions for direction ni for a three dimensio...
Definition: constants.f90:275
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
problem_constants::problem_standard_elasticity_darcy_subtype
integer(intg), parameter problem_standard_elasticity_darcy_subtype
Definition: problem_constants.f90:240
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
finite_elasticity_routines::evaluate_chapelle_piola_tensor_addition
subroutine evaluate_chapelle_piola_tensor_addition(AZL, AZU, DARCY_MASS_INCREASE, PIOLA_TENSOR_ADDITION, ERR, ERROR,)
Evaluates the 2nd Piola-Kirchhoff stress tensor; Eq.(13) in Chapelle, Gerbeau, Sainte-Marie, Vignon-Clementel, Computational Mechanics (2010)
Definition: finite_elasticity_routines.f90:10848
equations_matrices_routines::equations_jacobian_finite_difference_calculated
integer(intg), parameter, public equations_jacobian_finite_difference_calculated
Use finite differencing to calculate the Jacobian.
Definition: equations_matrices_routines.f90:115
equations_set_constants::equations_set_1d3d_monodomain_active_strain_subtype
integer(intg), parameter equations_set_1d3d_monodomain_active_strain_subtype
Definition: equations_set_constants.f90:313
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
problem_constants::problem_finite_elasticity_contact_type
integer(intg), parameter problem_finite_elasticity_contact_type
Definition: problem_constants.f90:71
types::solver_matrix_type
Contains information on the solver matrix.
Definition: types.f90:2411
finite_elasticity_routines::get_darcy_finite_elasticity_parameters
subroutine, public get_darcy_finite_elasticity_parameters(DARCY_RHO_0_F, Mfact, bfact, p0fact, ERR, ERROR,)
Sets some data for the coupled Darcy / finite-elasticity model.
Definition: finite_elasticity_routines.f90:10917
iso_varying_string::trim
Definition: iso_varying_string.f90:204
lapack
This module contains the interface descriptions to the LAPACK routines.
Definition: lapack.f90:45
boundary_conditions_routines::boundary_conditions_set_node
subroutine, public boundary_conditions_set_node(BOUNDARY_CONDITIONS, FIELD, VARIABLE_TYPE, VERSION_NUMBER, DERIVATIVE_NUMBER, USER_NODE_NUMBER, COMPONENT_NUMBER, CONDITION, VALUE, ERR, ERROR,)
Sets a boundary condition on the specified user node.
Definition: boundary_condition_routines.f90:2922
equations_set_constants::equations_set_orthotropic_material_holzapfel_ogden_subtype
integer(intg), parameter equations_set_orthotropic_material_holzapfel_ogden_subtype
Definition: equations_set_constants.f90:129
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
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
problem_constants::problem_fe_contact_transform_subtype
integer(intg), parameter problem_fe_contact_transform_subtype
Definition: problem_constants.f90:127
finite_elasticity_routines::finiteelasticity_finiteelementpreresidualevaluate
subroutine, public finiteelasticity_finiteelementpreresidualevaluate(EQUATIONS_SET, ERR, ERROR,)
Pre-evaluates the residual for a finite elasticity finite element equations set.
Definition: finite_elasticity_routines.f90:2569
maths::matrixtranspose
Returns the transpose of a matrix A in A^T.
Definition: maths.f90:197
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
equations_set_constants::equations_set_activecontraction_subtype
integer(intg), parameter equations_set_activecontraction_subtype
Definition: equations_set_constants.f90:126
equations_set_constants::equations_set_guccione_activecontraction_subtype
integer(intg), parameter equations_set_guccione_activecontraction_subtype
Definition: equations_set_constants.f90:152
solver_routines::solver_nonlinear_type
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
Definition: solver_routines.f90:89
maths::matrixtransposeproduct
Calculates and returns the matrix-transpose product A^T*B in the matrix C.
Definition: maths.f90:179
timer::system_cpu
integer(intg), parameter, public system_cpu
System CPU time type.
Definition: timer_f.f90:69
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_c2_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_c2_idx
c2 parameter index
Definition: finite_elasticity_routines.f90:103
solver_routines::solver_geometric_transformation_type
integer(intg), parameter, public solver_geometric_transformation_type
An geometric transformation solver.
Definition: solver_routines.f90:96
equations_set_constants::equations_set_incompressible_mooney_rivlin_subtype
integer(intg), parameter equations_set_incompressible_mooney_rivlin_subtype
Definition: equations_set_constants.f90:141
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
finite_elasticity_routines::finiteelasticity_gaussdeformationgradienttensor
subroutine, public finiteelasticity_gaussdeformationgradienttensor(dependentInterpPointMetrics, geometricInterpPointMetrics, fibreInterpolatedPoint, dZdNu, err, error,)
Evaluates the deformation gradient tensor at a given Gauss point.
Definition: finite_elasticity_routines.f90:3594
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
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
input_output::write_string_matrix_name_and_indices
integer(intg), parameter, public write_string_matrix_name_and_indices
Write the matrix name together with the matrix indices.
Definition: input_output.f90:66
input_output::writestringvalue
Write a string followed by a value to a given output stream.
Definition: input_output.f90:97
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
equations_set_constants::equations_set_transverse_isotropic_humphrey_yin_subtype
integer(intg), parameter equations_set_transverse_isotropic_humphrey_yin_subtype
Definition: equations_set_constants.f90:143
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
finite_elasticity_routines::finiteelasticity_finiteelementjacobianevaluate
subroutine, public finiteelasticity_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element Jacobian matrix for the given element number for a finite elasticity class fini...
Definition: finite_elasticity_routines.f90:832
equations_set_constants::equations_set_multiscale_active_strain_subtype
integer(intg), parameter equations_set_multiscale_active_strain_subtype
Definition: equations_set_constants.f90:155
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
types::basis_ptr_type
A buffer type to allow for an array of pointers to a BASIS_TYPE.
Definition: types.f90:179
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
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
finite_elasticity_routines::finite_elasticity_push_stress_tensor
subroutine finite_elasticity_push_stress_tensor(STRESS_TENSOR, DZDNU, Jznu, ERR, ERROR,)
Push-forward the rank 2 Piola stress tensor.
Definition: finite_elasticity_routines.f90:1265
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::mesh_type
Contains information on a mesh defined on a region.
Definition: types.f90:503
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_c1_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_c1_idx
c1 parameter index
Definition: finite_elasticity_routines.f90:102
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
finite_elasticity_routines::finiteelasticityequationsset_derivedvariablecalculate
subroutine, public finiteelasticityequationsset_derivedvariablecalculate(equationsSet, derivedType, err, error,)
Calculated an output field for a finite elasticity equations set.
Definition: finite_elasticity_routines.f90:2712
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
solver_routines::solver_progress_output
integer(intg), parameter, public solver_progress_output
Progress output from solver routines.
Definition: solver_routines.f90:350
maths::determinant
Returns the determinant of a matrix.
Definition: maths.f90:94
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_rin_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_rin_idx
Inner radius parameter index.
Definition: finite_elasticity_routines.f90:100
types::generated_mesh_type
Contains information on a generated mesh.
Definition: types.f90:579
equations_set_constants::equations_set_transverse_isotropic_active_subtype
integer(intg), parameter equations_set_transverse_isotropic_active_subtype
Definition: equations_set_constants.f90:147
equations_set_constants::equations_set_incompressible_finite_elasticity_darcy_subtype
integer(intg), parameter equations_set_incompressible_finite_elasticity_darcy_subtype
Definition: equations_set_constants.f90:128
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_set_constants::equations_set_incompressible_elasticity_driven_darcy_subtype
integer(intg), parameter equations_set_incompressible_elasticity_driven_darcy_subtype
Definition: equations_set_constants.f90:131
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
finite_elasticity_routines::finiteelasticity_presolvegetsoliddisplacement
subroutine finiteelasticity_presolvegetsoliddisplacement(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Read in the displacement field for a PGM elasticity problem.
Definition: finite_elasticity_routines.f90:10292
equations_set_constants::equations_set_isotropic_exponential_subtype
integer(intg), parameter equations_set_isotropic_exponential_subtype
Definition: equations_set_constants.f90:122
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
equations_set_constants::equations_set_elasticity_fluid_pressure_static_inria_subtype
integer(intg), parameter equations_set_elasticity_fluid_pressure_static_inria_subtype
Definition: equations_set_constants.f90:136
types::quadrature_scheme_ptr_type
A buffer type to allow for an array of pointers to a QUADRATURE_SCHEME_TYPE.
Definition: types.f90:156
equations_set_constants::equations_set_orthotropic_material_costa_subtype
integer(intg), parameter equations_set_orthotropic_material_costa_subtype
Definition: equations_set_constants.f90:124
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
finite_elasticity_routines::finite_elasticity_gauss_dfdz
subroutine finite_elasticity_gauss_dfdz(INTERPOLATED_POINT, ELEMENT_NUMBER, GAUSS_POINT_NUMBER, NUMBER_OF_DIMENSIONS, NUMBER_OF_XI, DFDZ, ERR, ERROR,)
Evaluates df/dz (derivative of interpolation function wrt deformed coord) matrix at a given Gauss poi...
Definition: finite_elasticity_routines.f90:5684
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
finite_elasticity_routines::finiteelasticity_finiteelementresidualevaluate
subroutine, public finiteelasticity_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the residual and RHS vectors for a finite elasticity finite element equations set...
Definition: finite_elasticity_routines.f90:1423
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
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_standard_elasticity_fluid_pressure_subtype
integer(intg), parameter problem_standard_elasticity_fluid_pressure_subtype
Definition: problem_constants.f90:250
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
equations_set_constants::equations_set_elasticity_darcy_inria_model_subtype
integer(intg), parameter equations_set_elasticity_darcy_inria_model_subtype
Definition: equations_set_constants.f90:130
timer::cpu_timer
subroutine, public cpu_timer(TIME_TYPE, TIME, ERR, ERROR,)
CPU_TIMER returns the CPU time in TIME(1). TIME_TYPE indicates the type of time required.
Definition: timer_f.f90:99
base_routines::diagnostics5
logical, save, public diagnostics5
.TRUE. if level 5 diagnostic output is active in the current routine
Definition: base_routines.f90:157
iso_varying_string::char
Definition: iso_varying_string.f90:138
field_io_routines
Implements lists of Field IO operation.
Definition: field_IO_routines.f90:46
finite_elasticity_routines::finiteelasticity_cylinderanalyticcalculate
subroutine finiteelasticity_cylinderanalyticcalculate(X, ANALYTIC_USER_PARAMS, DEFORMED_X, P, ERR, ERROR,)
Calcualates the analytic solution (deformed coordinates and hydrostatic pressure) for cylinder inflat...
Definition: finite_elasticity_routines.f90:499
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
equations_set_constants::equations_set_derived_strain
integer(intg), parameter equations_set_derived_strain
Strain tensor field.
Definition: equations_set_constants.f90:388
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
fluid_mechanics_io_routines::field
type(field_type), pointer field
Definition: fluid_mechanics_IO_routines.f90:174
equations_mapping_routines::equationsmapping_residualvariablesnumberset
subroutine, public equationsmapping_residualvariablesnumberset(EQUATIONS_MAPPING, NUMBER_OF_VARIABLES, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set residual vector...
Definition: equations_mapping_routines.f90:2302
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
equations_set_constants::equations_set_constitutive_law_in_cellml_evaluate_subtype
integer(intg), parameter equations_set_constitutive_law_in_cellml_evaluate_subtype
Definition: equations_set_constants.f90:137
equations_set_constants::equations_set_monodomain_elasticity_velocity_subtype
integer(intg), parameter equations_set_monodomain_elasticity_velocity_subtype
Definition: equations_set_constants.f90:312
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
domain_mappings::domain_mappings_global_to_local_get
subroutine, public domain_mappings_global_to_local_get(DOMAIN_MAPPING, GLOBAL_NUMBER, LOCAL_EXISTS, LOCAL_NUMBER, ERR, ERROR,)
Returns the local number, if it exists on the rank, for the specifed global number.
Definition: domain_mappings.f90:144
problem_constants::problem_pgm_elasticity_darcy_subtype
integer(intg), parameter problem_pgm_elasticity_darcy_subtype
Definition: problem_constants.f90:241
problem_constants::problem_finite_elasticity_with_growth_cellml_subtype
integer(intg), parameter problem_finite_elasticity_with_growth_cellml_subtype
Definition: problem_constants.f90:120
equations_set_constants::equations_set_elasticity_multi_compartment_darcy_inria_subtype
integer(intg), parameter equations_set_elasticity_multi_compartment_darcy_inria_subtype
Definition: equations_set_constants.f90:132
equations_set_constants::equations_set_transverse_isotropic_polynomial_subtype
integer(intg), parameter equations_set_transverse_isotropic_polynomial_subtype
Definition: equations_set_constants.f90:140
types::solver_matrices_type
Contains information on the solver matrices and rhs vector.
Definition: types.f90:2427
finite_elasticity_routines::finite_elasticity_pre_solve
subroutine, public finite_elasticity_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the finite elasticity problem pre-solve.
Definition: finite_elasticity_routines.f90:9695
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
maths::identitymatrix
Returns the identity matrix.
Definition: maths.f90:155
input_output::writestring
Write a string to a given output stream.
Definition: input_output.f90:80
finite_elasticity_routines::finiteelasticity_equationssetspecificationset
subroutine, public finiteelasticity_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a finite elasticity equation type of an elasticity equations set ...
Definition: finite_elasticity_routines.f90:8550
solver_routines::solver_label_set
Definition: solver_routines.f90:405
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
equations_set_constants::equations_set_stvenant_kirchoff_activecontraction_subtype
integer(intg), parameter equations_set_stvenant_kirchoff_activecontraction_subtype
Definition: equations_set_constants.f90:145
finite_elasticity_routines::finiteelasticity_surfacepressurejacobianevaluate
subroutine finiteelasticity_surfacepressurejacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Definition: finite_elasticity_routines.f90:3250
problem_constants::problem_finite_elasticity_cellml_subtype
integer(intg), parameter problem_finite_elasticity_cellml_subtype
Definition: problem_constants.f90:118
problem_constants::problem_control_load_increment_loop_type
integer(intg), parameter problem_control_load_increment_loop_type
Load increment control loop.
Definition: problem_constants.f90:285
types::domain_mapping_type
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
finite_elasticity_routines::finiteelasticity_straintensor_newer123
subroutine finiteelasticity_straintensor_newer123(deformationGradientTensor, rightCauchyDeformationTensor, fingerDeformationTensor, Jacobian, greenStrainTensor, err, error,)
Evaluates the strain tensor given the deformation gradient tensor.
Definition: finite_elasticity_routines.f90:5398
problem_constants::problem_quasistatic_elast_trans_darcy_mat_solve_subtype
integer(intg), parameter problem_quasistatic_elast_trans_darcy_mat_solve_subtype
Definition: problem_constants.f90:243
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
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
equations_set_constants::equations_set_elasticity_fluid_pres_holmes_mow_active_subtype
integer(intg), parameter equations_set_elasticity_fluid_pres_holmes_mow_active_subtype
Definition: equations_set_constants.f90:138
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
constants::voigt_to_tensor3
integer(intg), dimension(2, 6), parameter voigt_to_tensor3
Definition: constants.f90:287
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_pin_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_pin_idx
Inner pressure parameter index.
Definition: finite_elasticity_routines.f90:96
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
equations_set_constants::equations_set_compressible_activecontraction_subtype
integer(intg), parameter equations_set_compressible_activecontraction_subtype
Definition: equations_set_constants.f90:146
finite_elasticity_routines::finiteelasticity_controlloadincrementlooppostloop
subroutine, public finiteelasticity_controlloadincrementlooppostloop(controlLoop, err, error,)
Executes after each loop of a control loop for finite elasticity problems, i.e., after each load incr...
Definition: finite_elasticity_routines.f90:9619
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
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants::equations_set_evaluate_cauchy_stress_tensor
integer(intg), parameter equations_set_evaluate_cauchy_stress_tensor
Cauchy stress tensor.
Definition: equations_set_constants.f90:401
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
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
input_output::writestringvector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:299
equations_set_constants::equations_set_monodomain_elasticity_w_titin_subtype
integer(intg), parameter equations_set_monodomain_elasticity_w_titin_subtype
Definition: equations_set_constants.f90:311
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
equations_set_constants::equations_set_trans_isotropic_active_transition_subtype
integer(intg), parameter equations_set_trans_isotropic_active_transition_subtype
Definition: equations_set_constants.f90:148
coordinate_routines::coordinate_jacobian_volume_type
integer(intg), parameter, public coordinate_jacobian_volume_type
Volume type Jacobian.
Definition: coordinate_routines.f90:94
equations_set_constants::equations_set_evaluate_green_lagrange_strain_tensor
integer(intg), parameter equations_set_evaluate_green_lagrange_strain_tensor
Green-Lagrange strain tensor.
Definition: equations_set_constants.f90:400
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
finite_elasticity_routines::finite_elasticity_evaluate_evolution_law
subroutine finite_elasticity_evaluate_evolution_law(SOLVER, ERR, ERROR,)
Evaluates the evolution law of a multiscale active strain muscle model.
Definition: finite_elasticity_routines.f90:9857
equations_set_constants::equations_set_nearly_incompressible_mooney_rivlin_subtype
integer(intg), parameter equations_set_nearly_incompressible_mooney_rivlin_subtype
Definition: equations_set_constants.f90:142
finite_elasticity_routines::finite_elasticity_problem_setup
subroutine, public finite_elasticity_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the finite elasticity problem.
Definition: finite_elasticity_routines.f90:8627
finite_elasticity_routines::finite_elasticity_analytic_cylinder_param_tsi_idx
integer(intg), parameter, public finite_elasticity_analytic_cylinder_param_tsi_idx
Tsi parameter index.
Definition: finite_elasticity_routines.f90:99
problem_constants::problem_elasticity_class
integer(intg), parameter problem_elasticity_class
Definition: problem_constants.f90:55
problem_constants::problem_monodomain_1d3d_active_strain_subtype
integer(intg), parameter problem_monodomain_1d3d_active_strain_subtype
Definition: problem_constants.f90:255
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
finite_elasticity_routines::evaluate_chapelle_function
subroutine, public evaluate_chapelle_function(Jznu, ffact, dfdJfact, ERR, ERROR,)
Evaluates the functions f(J) and f\&#39;(J); Eq.(21) in Chapelle, Gerbeau, Sainte-Marie, Vignon-Clementel, Computational Mechanics (2010)
Definition: finite_elasticity_routines.f90:10814
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
finite_elasticity_routines::finiteelasticity_controltimelooppreloop
subroutine, public finiteelasticity_controltimelooppreloop(CONTROL_LOOP, ERR, ERROR,)
Runs before each time loop for a finite elasticity problem.
Definition: finite_elasticity_routines.f90:9545
problem_constants::problem_control_while_loop_type
integer(intg), parameter problem_control_while_loop_type
While control loop.
Definition: problem_constants.f90:284
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
finite_elasticity_routines
This module handles all finite elasticity routines.
Definition: finite_elasticity_routines.f90:45
maths::matrixproduct
Calculates and returns the matrix-product A*B in the matrix C.
Definition: maths.f90:173
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
comp_environment::computational_node_number_get
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
Definition: computational_environment.f90:640
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
problem_constants::problem_gudunov_monodomain_1d3d_elasticity_subtype
integer(intg), parameter problem_gudunov_monodomain_1d3d_elasticity_subtype
Definition: problem_constants.f90:252
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
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
finite_elasticity_routines::finite_elasticity_load_increment_apply
subroutine, public finite_elasticity_load_increment_apply(EQUATIONS_SET, ITERATION_NUMBER, MAXIMUM_NUMBER_OF_ITERATIONS, ERR, ERROR,)
Apply load increments to the gravity vector.
Definition: finite_elasticity_routines.f90:10947
equations_set_constants::equations_set_derived_stress
integer(intg), parameter equations_set_derived_stress
Stress tensor field.
Definition: equations_set_constants.f90:389
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
finite_elasticity_routines::finiteelasticity_problemspecificationset
subroutine, public finiteelasticity_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a finite elasticity type problem.
Definition: finite_elasticity_routines.f90:9204
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
finite_elasticity_routines::finiteelasticity_contactproblemsetup
subroutine, public finiteelasticity_contactproblemsetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the finite elasticity problem.
Definition: finite_elasticity_routines.f90:8968
problem_constants::problem_gudunov_monodomain_simple_elasticity_subtype
integer(intg), parameter problem_gudunov_monodomain_simple_elasticity_subtype
Definition: problem_constants.f90:251
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45