OpenCMISS-Iron Internal API Documentation
linear_elasticity_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE linear_elasticity_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE boundary_conditions_routines
50  USE constants
51  USE control_loop_routines
52  USE distributed_matrix_vector
53  USE domain_mappings
54  USE equations_routines
55  USE equations_mapping_routines
56  USE equations_matrices_routines
57  USE equations_set_constants
58  USE field_routines
59  USE input_output
60  USE iso_varying_string
61  USE kinds
62  USE matrix_vector
63  USE problem_constants
64  USE strings
65  USE solver_routines
66  USE timer
67  USE types
68  USE maths
69 
70 #include "macros.h"
71 
72  IMPLICIT NONE
73 
74  PRIVATE
75 
76  !Module parameters
77 
78  !Module types
79 
80  !Module variables
81 
82  !Interfaces
83 
84  PUBLIC linear_elasticity_finite_element_calculate
85 
86  PUBLIC linear_elasticity_equations_set_setup
87 
88  PUBLIC linearelasticity_equationssetsolutionmethodset
89 
90  PUBLIC linearelasticity_boundaryconditionsanalyticcalculate
91 
92  PUBLIC linearelasticity_equationssetspecificationset
93 
94  PUBLIC linearelasticity_problemspecificationset
95 
96  PUBLIC linear_elasticity_problem_setup
97 
98 CONTAINS
99 
100  !
101  !================================================================================================================================
102  !
103 
105  SUBROUTINE linearelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
106 
107  !Argument variables
108  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
109  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
110  INTEGER(INTG), INTENT(OUT) :: ERR
111  TYPE(varying_string), INTENT(OUT) :: ERROR
112  !Local Variables
113  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type
114  INTEGER(INTG) :: BC_X_FORCE_counter,BC_X_counter,BC_Y_counter,BC_X_Nodes,BC_Z_Nodes
115  REAL(DP) :: ANALYTIC_VALUE,BC_VALUE,X(3),GEOMETRIC_TOL,FORCE_X,FORCE_Y,FORCE_Y_AREA,LENGTH,WIDTH,HEIGHT,E,v_X,FORCE_X_AREA
116  REAL(DP) :: FORCE_Z,Iyy
117  REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
118  LOGICAL :: SET_BC
119  TYPE(domain_type), POINTER :: DOMAIN
120  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
121  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
122  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
123  TYPE(varying_string) :: LOCAL_ERROR
124 
125  enters("LinearElasticity_BoundaryConditionsAnalyticCalculate",err,error,*999)
126  geometric_tol=1.0e-6_dp
127  !!TODO: Use Geometric/Material Field values to prescribe values in analytic solution, currently hardcodded geometry & material properties
128  IF(ASSOCIATED(equations_set)) THEN
129  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
130  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
131  IF(ASSOCIATED(dependent_field)) THEN
132  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
133  IF(ASSOCIATED(geometric_field)) THEN
134  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
135  NULLIFY(geometric_variable)
136  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
137  NULLIFY(geometric_parameters)
138  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
139  & err,error,*999)
140  !
141  ! IDENTIFY BOUNDARY CONDITION NODES
142  !
143  bc_x_nodes = 0
144  bc_z_nodes = 0
145  bc_x_counter = 0
146  bc_y_counter = 0
147  bc_x_force_counter = 0
148  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
149  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
150  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
151  IF(ASSOCIATED(field_variable)) THEN
152  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
153  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
154  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
155  IF(ASSOCIATED(domain)) THEN
156  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
157  domain_nodes=>domain%TOPOLOGY%NODES
158  IF(ASSOCIATED(domain_nodes)) THEN
159  !Loop over the local nodes excluding the ghosts.
160  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
161  !!TODO \todo We should interpolate the geometric field here and the node position.
162  DO dim_idx=1,number_of_dimensions
163  !Default to version 1 of each node derivative
164  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
165  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
166  x(dim_idx)=geometric_parameters(local_ny)
167  ENDDO !dim_idx
168  !Loop over the derivatives
169  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
170  set_bc = .false.
171  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
172  !
173  ! ONE DIMENSIONAL LINEAR ELASTICITY
174  !
175  CASE(equations_set_linear_elasticity_one_dim_1)
176  SELECT CASE(variable_type)
177  CASE(field_u_variable_type)
178  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
179  CASE(no_global_deriv)
180  !pass
181  END SELECT
182  CASE(field_deludeln_variable_type)
183  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
184  CASE(no_global_deriv)
185  !pass
186  END SELECT
187  END SELECT
188 
189  !
190  ! TWO DIMENSIONAL LINEAR ELASTICITY
191  !
192  CASE(equations_set_linear_elasticity_two_dim_1)
193  SELECT CASE(component_idx)
194  CASE(1) !u component
195  SELECT CASE(variable_type)
196  CASE(field_u_variable_type)
197  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
198  CASE(no_global_deriv)
199  !pass
200  END SELECT
201  CASE(field_deludeln_variable_type)
202  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
203  CASE(no_global_deriv)
204  !pass
205  END SELECT
206  END SELECT
207  CASE(2) !v component
208  SELECT CASE(variable_type)
209  CASE(field_u_variable_type)
210  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
211  CASE(no_global_deriv)
212  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
213  bc_x_counter = bc_x_counter + 1
214  ENDIF
215  IF (abs(x(2)-0.0_dp) < geometric_tol) THEN
216  bc_y_counter = bc_y_counter + 1
217  ENDIF
218  END SELECT
219  CASE(field_deludeln_variable_type)
220  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
221  CASE(no_global_deriv)
222  !pass
223  END SELECT
224  END SELECT
225  END SELECT
226 
227  !
228  ! THREE DIMENSIONAL LINEAR ELASTICITY
229  !
230 
231  CASE(equations_set_linear_elasticity_three_dim_1)
232  length = 20.0_dp
233  width=20.0_dp
234  height=5.0_dp
235  SELECT CASE(component_idx)
236  CASE(1) !u component
237  SELECT CASE(variable_type)
238  CASE(field_u_variable_type)
239  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
240  CASE(no_global_deriv)
241  !pass
242  END SELECT
243  CASE(field_deludeln_variable_type)
244  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
245  CASE(no_global_deriv)
246  !pass
247  END SELECT
248  END SELECT
249  CASE(2) !v component
250  SELECT CASE(variable_type)
251  CASE(field_u_variable_type)
252  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
253  CASE(no_global_deriv)
254  !pass
255  END SELECT
256  CASE(field_deludeln_variable_type)
257  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
258  CASE(no_global_deriv)
259  IF (abs(x(2)-width) < geometric_tol) THEN
260  IF (abs(x(1)-length) < geometric_tol) THEN
261  bc_z_nodes = bc_z_nodes + 1
262  ENDIF
263  IF (abs(x(3)-height) < geometric_tol) THEN
264  bc_x_nodes = bc_x_nodes + 1
265  ENDIF
266  ENDIF
267  END SELECT
268  END SELECT
269  CASE(3) !w component
270  SELECT CASE(variable_type)
271  CASE(field_u_variable_type)
272  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
273  CASE(no_global_deriv)
274  !pass
275  END SELECT
276  CASE(field_deludeln_variable_type)
277  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
278  CASE(no_global_deriv)
279  !pass
280  END SELECT
281  END SELECT
282  END SELECT
283 
284 
285  !
286  ! THREE DIMENSIONAL LINEAR ELASTICITY FLEXURE
287  !
288 
289  CASE(equations_set_linear_elasticity_three_dim_2)
290  !LENGTH = 1.0_DP
291  !WIDTH=2.0_DP
292  !HEIGHT=5.0_DP
293  SELECT CASE(component_idx)
294  CASE(1) !u component
295  SELECT CASE(variable_type)
296  CASE(field_u_variable_type)
297  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
298  CASE(no_global_deriv)
299  !pass
300  END SELECT
301  CASE(field_deludeln_variable_type)
302  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
303  CASE(no_global_deriv)
304  !pass
305  END SELECT
306  END SELECT
307  CASE(2) !v component
308  SELECT CASE(variable_type)
309  CASE(field_u_variable_type)
310  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
311  CASE(no_global_deriv)
312  !pass
313  END SELECT
314  CASE(field_deludeln_variable_type)
315  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
316  CASE(no_global_deriv)
317  !pass
318  END SELECT
319  END SELECT
320  CASE(3) !w component
321  SELECT CASE(variable_type)
322  CASE(field_u_variable_type)
323  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
324  CASE(no_global_deriv)
325  !pass
326  END SELECT
327  CASE(field_deludeln_variable_type)
328  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
329  CASE(no_global_deriv)
330  !pass
331  END SELECT
332  END SELECT
333  END SELECT
334 
335  CASE DEFAULT
336  local_error="The analytic function type of "// &
337  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
338  & " is invalid."
339  CALL flagerror(local_error,err,error,*999)
340  END SELECT
341  ENDDO !deriv_idx
342  ENDDO !node_idx
343  ELSE
344  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
345  ENDIF
346  ELSE
347  CALL flagerror("Domain topology is not associated.",err,error,*999)
348  ENDIF
349  ELSE
350  CALL flagerror("Domain is not associated.",err,error,*999)
351  ENDIF
352  ELSE
353  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
354  ENDIF
355  ENDDO !component_idx
356  ELSE
357  CALL flagerror("Field variable is not associated.",err,error,*999)
358  ENDIF
359  ENDDO !variable_idx
360 
361  !
362  ! SET BOUNDARY CONDITIONS & ANALYTIC SOLUTION VALUES
363  !
364  IF(ASSOCIATED(boundary_conditions)) THEN
365  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
366  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
367  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
368  IF(ASSOCIATED(field_variable)) THEN
369  CALL field_parameter_set_create(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
370  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
371  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
372  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
373  IF(ASSOCIATED(domain)) THEN
374  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
375  domain_nodes=>domain%TOPOLOGY%NODES
376  IF(ASSOCIATED(domain_nodes)) THEN
377  !Loop over the local nodes excluding the ghosts.
378  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
379  !!TODO \todo We should interpolate the geometric field here and the node position.
380  DO dim_idx=1,number_of_dimensions
381  !Default to version 1 of each node derivative
382  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
383  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
384  x(dim_idx)=geometric_parameters(local_ny)
385  ENDDO !dim_idx
386  !Loop over the derivatives
387  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
388  set_bc = .false.
389  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
390  !
391  ! ONE DIMENSIONAL LINEAR ELASTICITY
392  !
393  CASE(equations_set_linear_elasticity_one_dim_1)
394  force_x=50.0_dp
395  length = 20.0_dp
396  width=20.0_dp
397  height=5.0_dp
398  force_x_area = width*height
399  e = 10e3_dp
400  SELECT CASE(variable_type)
401  !!TODO set material parameters from material field
402  CASE(field_u_variable_type)
403  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
404  CASE(no_global_deriv)
405  analytic_value=(x(1)*(force_x/force_x_area))/e
406  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
407  set_bc = .true.
408  bc_value=0.0_dp
409  ENDIF
410  CASE(global_deriv_s1)
411  analytic_value=1.0_dp
412  CASE DEFAULT
413  local_error="The global derivative index of "//trim(number_to_vstring( &
414  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
415  & err,error))//" is invalid."
416  CALL flagerror(local_error,err,error,*999)
417  END SELECT
418  CASE(field_deludeln_variable_type)
419  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
420  CASE(no_global_deriv)
421  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
422  analytic_value=-force_x
423  ELSE
424  analytic_value=0.0_dp
425  ENDIF
426  IF (abs(x(1)-length) < geometric_tol) THEN
427  set_bc = .true.
428  bc_value=-force_x
429  ENDIF
430  CASE(global_deriv_s1)
431  analytic_value=1.0_dp
432  CASE DEFAULT
433  local_error="The global derivative index of "//trim(number_to_vstring( &
434  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
435  & err,error))//" is invalid."
436  CALL flagerror(local_error,err,error,*999)
437  END SELECT
438  CASE DEFAULT
439  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
440  & " is invalid."
441  CALL flagerror(local_error,err,error,*999)
442  END SELECT
443  !
444  ! TWO DIMENSIONAL LINEAR ELASTICITY
445  !
446  CASE(equations_set_linear_elasticity_two_dim_1)
447  length = 20.0_dp
448  width=20.0_dp
449  height=5.0_dp
450  force_y=50.0_dp
451  force_y_area=width*height
452  e = 10.0e3_dp
453  v_x = 0.3_dp
454  SELECT CASE(component_idx)
455  CASE(1) !u component
456  !u=Sigmax*x/E
457  SELECT CASE(variable_type)
458  !!TODO set material parameters from material field
459  CASE(field_u_variable_type)
460  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
461  CASE(no_global_deriv)
462  analytic_value=(-v_x*x(1)*(force_y/force_y_area))/e
463  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
464  set_bc = .true.
465  bc_value=0.0_dp
466  ENDIF
467  CASE(global_deriv_s1)
468  analytic_value=1.0_dp
469  CASE(global_deriv_s2)
470  analytic_value=1.0_dp
471  CASE(global_deriv_s1_s2)
472  analytic_value=1.0_dp
473  CASE DEFAULT
474  local_error="The global derivative index of "//trim(number_to_vstring( &
475  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
476  & err,error))//" is invalid."
477  CALL flagerror(local_error,err,error,*999)
478  END SELECT
479  CASE(field_deludeln_variable_type)
480  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
481  CASE(no_global_deriv)
482  analytic_value=0.0_dp
483  CASE(global_deriv_s1)
484  analytic_value=1.0_dp
485  CASE(global_deriv_s2)
486  analytic_value=1.0_dp
487  CASE(global_deriv_s1_s2)
488  analytic_value=1.0_dp
489  CASE DEFAULT
490  local_error="The global derivative index of "//trim(number_to_vstring( &
491  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
492  & err,error))//" is invalid."
493  CALL flagerror(local_error,err,error,*999)
494  END SELECT
495  CASE DEFAULT
496  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
497  & " is invalid."
498  CALL flagerror(local_error,err,error,*999)
499  END SELECT
500  CASE(2) !v component
501  !v=Sigmay*y/E
502  SELECT CASE(variable_type)
503  CASE(field_u_variable_type)
504  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
505  CASE(no_global_deriv)
506  analytic_value=(x(2)*(force_y/force_y_area))/e
507  IF (abs(x(2)-0.0_dp) < geometric_tol) THEN
508  set_bc = .true.
509  bc_value=0.0_dp
510  ENDIF
511  CASE(global_deriv_s1)
512  analytic_value=0.0_dp
513  CASE(global_deriv_s2)
514  analytic_value=0.0_dp
515  CASE(global_deriv_s1_s2)
516  analytic_value=0.0_dp
517  CASE DEFAULT
518  local_error="The global derivative index of "//trim(number_to_vstring( &
519  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
520  & err,error))//" is invalid."
521  CALL flagerror(local_error,err,error,*999)
522  END SELECT
523  CASE(field_deludeln_variable_type)
524  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
525  CASE(no_global_deriv)
526  analytic_value=0.0_dp
527  !If node located on a line edge of mesh
528  IF (abs(x(2)-width) < geometric_tol) THEN !Apply Force BC
529  set_bc = .true.
530  IF ((abs(x(1)-0.0_dp) < geometric_tol) .OR. (abs(x(1)-length) < geometric_tol)) THEN !lies on a corner of the mesh
531  bc_value=-force_y/(bc_y_counter-1.0_dp)*0.5_dp
532  ELSE !does not lie on a corner of the mesh
533  bc_value=-force_y/(bc_y_counter-1.0_dp)
534  ENDIF
535  ELSEIF (abs(x(2)-0) < geometric_tol) THEN !Provide Analytic reaction force, node located on fixed displacment edge
536  IF ((abs(x(1)-0.0_dp) < geometric_tol) .OR. (abs(x(1)-length) < geometric_tol)) THEN !lies on a corner of the mesh
537  analytic_value=-force_y/(bc_y_counter-1.0_dp)*0.5_dp
538  ELSE !does not lie on a corner of the mesh
539  analytic_value=-force_y/(bc_y_counter-1.0_dp)
540  ENDIF
541  ENDIF
542  CASE(global_deriv_s1)
543  analytic_value=0.0_dp
544  CASE(global_deriv_s2)
545  analytic_value=0.0_dp
546  CASE(global_deriv_s1_s2)
547  analytic_value=0.0_dp
548  CASE DEFAULT
549  local_error="The global derivative index of "//trim(number_to_vstring( &
550  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
551  & err,error))//" is invalid."
552  CALL flagerror(local_error,err,error,*999)
553  END SELECT
554  CASE DEFAULT
555  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
556  & " is invalid."
557  CALL flagerror(local_error,err,error,*999)
558  END SELECT
559  CASE DEFAULT
560  local_error="The component index of "//trim(number_to_vstring(component_idx,"*",err,error))// &
561  & " is invalid."
562  CALL flagerror(local_error,err,error,*999)
563  END SELECT
564 
565  !
566  ! THREE DIMENSIONAL LINEAR ELASTICITY
567  !
568 
569  CASE(equations_set_linear_elasticity_three_dim_1)
570  length = 20.0_dp
571  width=20.0_dp
572  height=5.0_dp
573  force_y=50.0_dp
574  force_y_area=width*height
575  e = 10.0e3_dp
576  v_x = 0.3_dp
577  SELECT CASE(component_idx)
578  CASE(1) !u component
579  !u=
580  SELECT CASE(variable_type)
581  CASE(field_u_variable_type)
582  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
583  CASE(no_global_deriv)
584  analytic_value=(-v_x*x(1)*(force_y/force_y_area))/e
585  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
586  set_bc = .true.
587  bc_value=0.0_dp
588  ENDIF
589  CASE(global_deriv_s1)
590  analytic_value=0.0_dp
591  CASE(global_deriv_s2)
592  analytic_value=0.0_dp
593  CASE(global_deriv_s1_s2)
594  analytic_value=0.0_dp
595  CASE(global_deriv_s3)
596  analytic_value=0.0_dp
597  CASE(global_deriv_s1_s3)
598  analytic_value=0.0_dp
599  CASE(global_deriv_s2_s3)
600  analytic_value=0.0_dp
601  CASE(global_deriv_s1_s2_s3)
602  analytic_value=0.0_dp
603  CASE DEFAULT
604  local_error="The global derivative index of "//trim(number_to_vstring( &
605  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
606  & err,error))//" is invalid."
607  CALL flagerror(local_error,err,error,*999)
608  END SELECT
609  CASE(field_deludeln_variable_type)
610  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
611  CASE(no_global_deriv)
612  analytic_value=0.0_dp
613  CASE(global_deriv_s1)
614  analytic_value=0.0_dp
615  CASE(global_deriv_s2)
616  analytic_value=0.0_dp
617  CASE(global_deriv_s1_s2)
618  analytic_value=0.0_dp
619  CASE(global_deriv_s3)
620  analytic_value=0.0_dp
621  CASE(global_deriv_s1_s3)
622  analytic_value=0.0_dp
623  CASE(global_deriv_s2_s3)
624  analytic_value=0.0_dp
625  CASE(global_deriv_s1_s2_s3)
626  analytic_value=0.0_dp
627  CASE DEFAULT
628  local_error="The global derivative index of "//trim(number_to_vstring( &
629  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
630  & err,error))//" is invalid."
631  CALL flagerror(local_error,err,error,*999)
632  END SELECT
633  CASE DEFAULT
634  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
635  & " is invalid."
636  CALL flagerror(local_error,err,error,*999)
637  END SELECT
638  CASE(2) !v component
639  !v=
640  SELECT CASE(variable_type)
641  CASE(field_u_variable_type)
642  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
643  CASE(no_global_deriv)
644  analytic_value=(x(2)*(force_y/force_y_area))/e
645  IF (abs(x(2)-0.0_dp) < geometric_tol) THEN
646  set_bc = .true.
647  bc_value=0.0_dp
648  ENDIF
649  CASE(global_deriv_s1)
650  analytic_value=0.0_dp
651  CASE(global_deriv_s2)
652  analytic_value=0.0_dp
653  CASE(global_deriv_s1_s2)
654  analytic_value=0.0_dp
655  CASE(global_deriv_s3)
656  analytic_value=0.0_dp
657  CASE(global_deriv_s1_s3)
658  analytic_value=0.0_dp
659  CASE(global_deriv_s2_s3)
660  analytic_value=0.0_dp
661  CASE(global_deriv_s1_s2_s3)
662  analytic_value=0.0_dp
663  CASE DEFAULT
664  local_error="The global derivative index of "//trim(number_to_vstring( &
665  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
666  & err,error))//" is invalid."
667  CALL flagerror(local_error,err,error,*999)
668  END SELECT
669  CASE(field_deludeln_variable_type)
670  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
671  CASE(no_global_deriv)
672  analytic_value=0.0_dp
673  IF (abs(x(2)-width) < geometric_tol) THEN !Apply Force BC
674  set_bc = .true.
675  IF (((abs(x(1)-0.0_dp) < geometric_tol) .AND. (abs(x(3)-0.0_dp) < geometric_tol)) .OR. &
676  & ((abs(x(1)-length) < geometric_tol) .AND. (abs(x(3)-0.0_dp) < geometric_tol)) .OR. &
677  & ((abs(x(1)-0.0_dp) < geometric_tol) .AND. (abs(x(3)-height) < geometric_tol)) .OR. &
678  & ((abs(x(1)-length) < geometric_tol) .AND. (abs(x(3)-height) < geometric_tol))) THEN !lies on a corner of the mesh
679  bc_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))*0.25_dp
680  ELSEIF ((abs(x(1)-0.0_dp) < geometric_tol) .OR. (abs(x(1)-length) < geometric_tol) .OR. &
681  & (abs(x(3)-0.0_dp) < geometric_tol) .OR. (abs(x(3)-height) < geometric_tol)) THEN !lies on an edge of the mesh
682  bc_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))*0.5_dp
683  ELSE !lies on xi2=1 face
684  bc_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))
685  ENDIF
686  ELSEIF (abs(x(2)-0.0_dp) < geometric_tol) THEN !Provide Analytic reaction force, node located on fixed displacment edge
687  IF (((abs(x(1)-0.0_dp) < geometric_tol) .AND. (abs(x(3)-0.0_dp) < geometric_tol)) .OR. &
688  & ((abs(x(1)-length) < geometric_tol) .AND. (abs(x(3)-0.0_dp) < geometric_tol)) .OR. &
689  & ((abs(x(1)-0.0_dp) < geometric_tol) .AND. (abs(x(3)-height) < geometric_tol)) .OR. &
690  & ((abs(x(1)-length) < geometric_tol) .AND. (abs(x(3)-height) < geometric_tol))) THEN !lies on a corner of the mesh
691  analytic_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))*0.25_dp
692  ELSEIF ((abs(x(1)-0.0_dp) < geometric_tol) .OR. (abs(x(1)-length) < geometric_tol) .OR. &
693  & (abs(x(3)-0.0_dp) < geometric_tol) .OR. (abs(x(3)-height) < geometric_tol)) THEN !lies on an edge of the mesh
694  analytic_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))*0.5_dp
695  ELSE !lies on xi2=1 face
696  analytic_value=-force_y/((bc_x_nodes-1.0_dp)*(bc_z_nodes-1.0_dp))
697  ENDIF
698  ENDIF
699  CASE(global_deriv_s1)
700  analytic_value=0.0_dp
701  CASE(global_deriv_s2)
702  analytic_value=0.0_dp
703  CASE(global_deriv_s1_s2)
704  analytic_value=0.0_dp
705  CASE(global_deriv_s3)
706  analytic_value=0.0_dp
707  CASE(global_deriv_s1_s3)
708  analytic_value=0.0_dp
709  CASE(global_deriv_s2_s3)
710  analytic_value=0.0_dp
711  CASE(global_deriv_s1_s2_s3)
712  analytic_value=0.0_dp
713  CASE DEFAULT
714  local_error="The global derivative index of "//trim(number_to_vstring( &
715  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
716  & err,error))//" is invalid."
717  CALL flagerror(local_error,err,error,*999)
718  END SELECT
719  CASE DEFAULT
720  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
721  & " is invalid."
722  CALL flagerror(local_error,err,error,*999)
723  END SELECT
724  CASE(3) !w component
725  !w=
726  SELECT CASE(variable_type)
727  CASE(field_u_variable_type)
728  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
729  CASE(no_global_deriv)
730  analytic_value=(-v_x*x(3)*(force_y/force_y_area))/e
731  IF (abs(x(3)-0.0_dp) < geometric_tol) THEN
732  set_bc = .true.
733  bc_value=0.0_dp
734  ENDIF
735  CASE(global_deriv_s1)
736  analytic_value=0.0_dp
737  CASE(global_deriv_s2)
738  analytic_value=0.0_dp
739  CASE(global_deriv_s1_s2)
740  analytic_value=0.0_dp
741  CASE(global_deriv_s3)
742  analytic_value=0.0_dp
743  CASE(global_deriv_s1_s3)
744  analytic_value=0.0_dp
745  CASE(global_deriv_s2_s3)
746  analytic_value=0.0_dp
747  CASE(global_deriv_s1_s2_s3)
748  analytic_value=0.0_dp
749  CASE DEFAULT
750  local_error="The global derivative index of "//trim(number_to_vstring( &
751  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
752  & err,error))//" is invalid."
753  CALL flagerror(local_error,err,error,*999)
754  END SELECT
755  CASE(field_deludeln_variable_type)
756  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
757  CASE(no_global_deriv)
758  analytic_value=0.0_dp
759  CASE(global_deriv_s1)
760  analytic_value=0.0_dp
761  CASE(global_deriv_s2)
762  analytic_value=0.0_dp
763  CASE(global_deriv_s1_s2)
764  analytic_value=0.0_dp
765  CASE(global_deriv_s3)
766  analytic_value=0.0_dp
767  CASE(global_deriv_s1_s3)
768  analytic_value=0.0_dp
769  CASE(global_deriv_s2_s3)
770  analytic_value=0.0_dp
771  CASE(global_deriv_s1_s2_s3)
772  analytic_value=0.0_dp
773  CASE DEFAULT
774  local_error="The global derivative index of "//trim(number_to_vstring( &
775  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
776  & err,error))//" is invalid."
777  CALL flagerror(local_error,err,error,*999)
778  END SELECT
779  CASE DEFAULT
780  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
781  & " is invalid."
782  CALL flagerror(local_error,err,error,*999)
783  END SELECT
784  CASE DEFAULT
785  local_error="The component index of "//trim(number_to_vstring(component_idx,"*",err,error))// &
786  & " is invalid."
787  CALL flagerror(local_error,err,error,*999)
788  END SELECT
789 
790 
791 
792  !
793  ! THREE DIMENSIONAL LINEAR ELASTICITY FLEXURE
794  !
795  CASE(equations_set_linear_elasticity_three_dim_2)
796  length = 5.0_dp
797  width=2.0_dp
798  height=2.0_dp
799  force_z=-1.0_dp
800  !FORCE_Z_AREA=WIDTH*HEIGHT
801  e = 10.0e3_dp
802  v_x = 0.3_dp
803  iyy = (height*(width**3.0_dp))/12.0_dp
804  SELECT CASE(component_idx)
805  CASE(1) !u component
806  !u=
807  SELECT CASE(variable_type)
808  CASE(field_u_variable_type)
809  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
810  CASE(no_global_deriv)
811  !ANALYTIC_VALUE=(-v_X*X(1)*(FORCE_Y/FORCE_Y_AREA))/E
812  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
813  set_bc = .true.
814  bc_value=0.0_dp
815  ENDIF
816  CASE(global_deriv_s1)
817  analytic_value=0.0_dp
818  CASE(global_deriv_s2)
819  analytic_value=0.0_dp
820  CASE(global_deriv_s1_s2)
821  analytic_value=0.0_dp
822  CASE(global_deriv_s3)
823  analytic_value=0.0_dp
824  CASE(global_deriv_s1_s3)
825  analytic_value=0.0_dp
826  CASE(global_deriv_s2_s3)
827  analytic_value=0.0_dp
828  CASE(global_deriv_s1_s2_s3)
829  analytic_value=0.0_dp
830  CASE DEFAULT
831  local_error="The global derivative index of "//trim(number_to_vstring( &
832  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
833  & err,error))//" is invalid."
834  CALL flagerror(local_error,err,error,*999)
835  END SELECT
836  CASE(field_deludeln_variable_type)
837  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
838  CASE(no_global_deriv)
839  analytic_value=0.0_dp
840  CASE(global_deriv_s1)
841  analytic_value=0.0_dp
842  CASE(global_deriv_s2)
843  analytic_value=0.0_dp
844  CASE(global_deriv_s1_s2)
845  analytic_value=0.0_dp
846  CASE(global_deriv_s3)
847  analytic_value=0.0_dp
848  CASE(global_deriv_s1_s3)
849  analytic_value=0.0_dp
850  CASE(global_deriv_s2_s3)
851  analytic_value=0.0_dp
852  CASE(global_deriv_s1_s2_s3)
853  analytic_value=0.0_dp
854  CASE DEFAULT
855  local_error="The global derivative index of "//trim(number_to_vstring( &
856  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
857  & err,error))//" is invalid."
858  CALL flagerror(local_error,err,error,*999)
859  END SELECT
860  CASE DEFAULT
861  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
862  & " is invalid."
863  CALL flagerror(local_error,err,error,*999)
864  END SELECT
865  CASE(2) !v component
866  !v=
867  SELECT CASE(variable_type)
868  CASE(field_u_variable_type)
869  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
870  CASE(no_global_deriv)
871  !ANALYTIC_VALUE=(X(2)*(FORCE_Y/FORCE_Y_AREA))/E
872  !IF (ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) THEN
873  ! SET_BC = .TRUE.
874  ! BC_VALUE=0.0_DP
875  !ENDIF
876  CASE(global_deriv_s1)
877  analytic_value=0.0_dp
878  CASE(global_deriv_s2)
879  analytic_value=0.0_dp
880  CASE(global_deriv_s1_s2)
881  analytic_value=0.0_dp
882  CASE(global_deriv_s3)
883  analytic_value=0.0_dp
884  CASE(global_deriv_s1_s3)
885  analytic_value=0.0_dp
886  CASE(global_deriv_s2_s3)
887  analytic_value=0.0_dp
888  CASE(global_deriv_s1_s2_s3)
889  analytic_value=0.0_dp
890  CASE DEFAULT
891  local_error="The global derivative index of "//trim(number_to_vstring( &
892  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
893  & err,error))//" is invalid."
894  CALL flagerror(local_error,err,error,*999)
895  END SELECT
896  CASE(field_deludeln_variable_type)
897  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
898  CASE(no_global_deriv)
899  analytic_value=0.0_dp
900 ! IF (ABS(X(2)-WIDTH) < GEOMETRIC_TOL) THEN !Apply Force BC
901 ! SET_BC = .TRUE.
902 ! IF (((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .AND. (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL)) .OR. &
903 ! & ((ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .AND. (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL)) .OR. &
904 ! & ((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .AND. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL)) .OR. &
905 ! & ((ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .AND. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL))) THEN !lies on a corner of the mesh
906 ! BC_VALUE=FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))*0.25_DP
907 ! ELSEIF ((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .OR. (ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .OR. &
908 ! & (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL) .OR. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL)) THEN !lies on an edge of the mesh
909 ! BC_VALUE=FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))*0.5_DP
910 ! ELSE !lies on xi2=1 face
911 ! BC_VALUE=FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))
912 ! ENDIF
913 ! ELSEIF (ABS(X(2)-0.0_DP) < GEOMETRIC_TOL) THEN !Provide Analytic reaction force, node located on fixed displacment edge
914 ! IF (((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .AND. (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL)) .OR. &
915 ! & ((ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .AND. (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL)) .OR. &
916 ! & ((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .AND. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL)) .OR. &
917 ! & ((ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .AND. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL))) THEN !lies on a corner of the mesh
918 ! ANALYTIC_VALUE=-FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))*0.25_DP
919 ! ELSEIF ((ABS(X(1)-0.0_DP) < GEOMETRIC_TOL) .OR. (ABS(X(1)-LENGTH) < GEOMETRIC_TOL) .OR. &
920 ! & (ABS(X(3)-0.0_DP) < GEOMETRIC_TOL) .OR. (ABS(X(3)-HEIGHT) < GEOMETRIC_TOL)) THEN !lies on an edge of the mesh
921 ! ANALYTIC_VALUE=-FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))*0.5_DP
922 ! ELSE !lies on xi2=1 face
923 ! ANALYTIC_VALUE=-FORCE_Y/((BC_X_Nodes-1.0_DP)*(BC_Z_Nodes-1.0_DP))
924 ! ENDIF
925 ! ENDIF
926  CASE(global_deriv_s1)
927  analytic_value=0.0_dp
928  CASE(global_deriv_s2)
929  analytic_value=0.0_dp
930  CASE(global_deriv_s1_s2)
931  analytic_value=0.0_dp
932  CASE(global_deriv_s3)
933  analytic_value=0.0_dp
934  CASE(global_deriv_s1_s3)
935  analytic_value=0.0_dp
936  CASE(global_deriv_s2_s3)
937  analytic_value=0.0_dp
938  CASE(global_deriv_s1_s2_s3)
939  analytic_value=0.0_dp
940  CASE DEFAULT
941  local_error="The global derivative index of "//trim(number_to_vstring( &
942  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
943  & err,error))//" is invalid."
944  CALL flagerror(local_error,err,error,*999)
945  END SELECT
946  CASE DEFAULT
947  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
948  & " is invalid."
949  CALL flagerror(local_error,err,error,*999)
950  END SELECT
951  CASE(3) !w component
952  !w=
953  SELECT CASE(variable_type)
954  CASE(field_u_variable_type)
955  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
956  CASE(no_global_deriv)
957  analytic_value=0.0_dp
958  IF ((abs(x(1)-0.0_dp) < geometric_tol) .AND. (abs(x(2)-0.0_dp) < geometric_tol)) THEN
959  analytic_value=(force_z*(3.0_dp*length-x(3))*x(3)**2.0_dp)/(6.0_dp*iyy*e)
960  ENDIF
961  IF (abs(x(1)-0.0_dp) < geometric_tol) THEN
962  set_bc = .true.
963  bc_value=0.0_dp
964  ENDIF
965  CASE(global_deriv_s1)
966  analytic_value=0.0_dp
967  CASE(global_deriv_s2)
968  analytic_value=0.0_dp
969  CASE(global_deriv_s1_s2)
970  analytic_value=0.0_dp
971  CASE(global_deriv_s3)
972  analytic_value=0.0_dp
973  CASE(global_deriv_s1_s3)
974  analytic_value=0.0_dp
975  CASE(global_deriv_s2_s3)
976  analytic_value=0.0_dp
977  CASE(global_deriv_s1_s2_s3)
978  analytic_value=0.0_dp
979  CASE DEFAULT
980  local_error="The global derivative index of "//trim(number_to_vstring( &
981  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
982  & err,error))//" is invalid."
983  CALL flagerror(local_error,err,error,*999)
984  END SELECT
985  CASE(field_deludeln_variable_type)
986  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
987  CASE(no_global_deriv)
988  IF ((abs(x(1)-length) < geometric_tol) .AND. (abs(x(2)-0.0_dp) < geometric_tol) .AND. &
989  (abs(x(3)-0.0_dp) < geometric_tol)) THEN
990  set_bc = .true.
991  bc_value=-force_z
992  ENDIF
993  analytic_value=0.0_dp
994  CASE(global_deriv_s1)
995  analytic_value=0.0_dp
996  CASE(global_deriv_s2)
997  analytic_value=0.0_dp
998  CASE(global_deriv_s1_s2)
999  analytic_value=0.0_dp
1000  CASE(global_deriv_s3)
1001  analytic_value=0.0_dp
1002  CASE(global_deriv_s1_s3)
1003  analytic_value=0.0_dp
1004  CASE(global_deriv_s2_s3)
1005  analytic_value=0.0_dp
1006  CASE(global_deriv_s1_s2_s3)
1007  analytic_value=0.0_dp
1008  CASE DEFAULT
1009  local_error="The global derivative index of "//trim(number_to_vstring( &
1010  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
1011  & err,error))//" is invalid."
1012  CALL flagerror(local_error,err,error,*999)
1013  END SELECT
1014  CASE DEFAULT
1015  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
1016  & " is invalid."
1017  CALL flagerror(local_error,err,error,*999)
1018  END SELECT
1019  CASE DEFAULT
1020  local_error="The component index of "//trim(number_to_vstring(component_idx,"*",err,error))// &
1021  & " is invalid."
1022  CALL flagerror(local_error,err,error,*999)
1023  END SELECT
1024 
1025 
1026 
1027 
1028 
1029 
1030  CASE DEFAULT
1031  local_error="The analytic function type of "// &
1032  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1033  & " is invalid."
1034  CALL flagerror(local_error,err,error,*999)
1035  END SELECT
1036  !Default to version 1 of each node derivative
1037  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
1038  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
1039  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
1040  & field_analytic_values_set_type,local_ny,analytic_value,err,error,*999)
1041  IF (set_bc) THEN
1042  !Default to version 1 of each node derivative
1043  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
1044  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
1045  WRITE(*,*) variable_type
1046  CALL boundary_conditions_set_local_dof(boundary_conditions,dependent_field,variable_type, &
1047  & local_ny,boundary_condition_fixed,bc_value,err,error,*999)
1048  ENDIF
1049  ENDDO !deriv_idx
1050  ENDDO !node_idx
1051  ELSE
1052  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
1053  ENDIF
1054  ELSE
1055  CALL flagerror("Domain topology is not associated.",err,error,*999)
1056  ENDIF
1057  ELSE
1058  CALL flagerror("Domain is not associated.",err,error,*999)
1059  ENDIF
1060  ELSE
1061  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
1062  ENDIF
1063  ENDDO !component_idx
1064  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
1065  & err,error,*999)
1066  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
1067  & err,error,*999)
1068  ELSE
1069  CALL flagerror("Field variable is not associated.",err,error,*999)
1070  ENDIF
1071  ENDDO !variable_idx
1072  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
1073  & geometric_parameters,err,error,*999)
1074  ELSE
1075  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
1076  ENDIF
1077  ELSE
1078  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1079  ENDIF
1080  ELSE
1081  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1082  ENDIF
1083  ELSE
1084  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1085  ENDIF
1086  ELSE
1087  CALL flagerror("Equations set is not associated.",err,error,*999)
1088  ENDIF
1089 
1090  exits("LinearElasticity_BoundaryConditionsAnalyticCalculate")
1091  RETURN
1092 999 errors("LinearElasticity_BoundaryConditionsAnalyticCalculate",err,error)
1093  exits("LinearElasticity_BoundaryConditionsAnalyticCalculate")
1094  RETURN 1
1095 
1096  END SUBROUTINE linearelasticity_boundaryconditionsanalyticcalculate
1097 
1098  !
1099  !================================================================================================================================
1100  !
1101 
1103  SUBROUTINE linear_elasticity_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
1104 
1105  !Argument variables
1106  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1108  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
1109  INTEGER(INTG), INTENT(OUT) :: ERR
1110  TYPE(varying_string), INTENT(OUT) :: ERROR
1111 
1112  !Local Variables
1113  INTEGER(INTG) :: FIELD_VAR_TYPE,ng,ni,xi,mi,ns,nhs,ms,mhs,TOTAL_DEPENDENT_BASIS_EP,MESH_COMPONENT
1114  INTEGER(INTG) :: NUMBER_OF_DEPENDENT_COMPONENTS,NUMBER_OF_XI !,NUMBER_OF_GEOMETRIC_COMPONENTS
1115  INTEGER(INTG) :: OFF_DIAG_COMP(3),OFF_DIAG_DEP_VAR(2,2,3),DIAG_SUB_MAT_LOC(3),OFF_DIAG_SUB_MAT_LOC(2,3)
1116  INTEGER(INTG) :: DEPENDENT_BASES_EP(3) !,GEOMETRIC_BASES_EP(:)
1117  REAL(DP) :: JRWG,C(6,6),JRWG_DIAG_C(3,3),JRWG_OFF_DIAG_C(2,3)
1118  REAL(DP):: SF(64*3)
1119 
1120  !LOGICAL :: SAME_BASIS
1121  TYPE(equations_type), POINTER :: EQUATIONS
1122  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
1123  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1124  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
1125  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1126  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
1127  TYPE(basis_ptr_type) :: DEPENDENT_BASES(3) !,GEOMETRIC_BASES(:)
1128  TYPE(quadrature_scheme_ptr_type) :: QUADRATURE_SCHEMES(3)
1129  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
1130  TYPE(field_interpolation_parameters_type), POINTER :: GEOMETRIC_INTERPOLATION_PARAMETERS
1131  TYPE(field_interpolation_parameters_type), POINTER :: DEPENDENT_INTERPOLATION_PARAMETERS
1132  !TYPE(FIELD_INTERPOLATION_PARAMETERS_TYPE), POINTER :: FIBRE_INTERPOLATION_PARAMETERS
1133  TYPE(field_interpolation_parameters_type), POINTER :: MATERIALS_INTERPOLATION_PARAMETERS
1134  TYPE(field_interpolated_point_type), POINTER :: MATERIALS_INTERP_POINT
1135  TYPE(field_interpolated_point_metrics_type), POINTER :: GEOMETRIC_INTERP_POINT_METRICS
1136  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
1137  TYPE(varying_string) :: LOCAL_ERROR
1138  TYPE dphi_dx_comp_type !A type to store DPHIDX for each mesh component
1139  REAL(DP) :: DPHIDX(64,3)
1140  END TYPE dphi_dx_comp_type
1141  TYPE(dphi_dx_comp_type) :: DPHIDX_COMP(3)
1142 
1143  enters("LINEAR_ELASTICITY_FINITE_ELEMENT_CALCULATE",err,error,*999)
1144  !!Have a look at XPES40.f in the old CMISS code.
1145  !!Q - CPB: Need to think about anisotropic materials with fibre fields.
1146  !!Q - CPB: why store this DPHIDX(ns,xi) as opposed to just using it directly? A - to minimize operations - Otherwise it would be calculated many more times than
1147  !! necessary within the loops below
1148  !!Q - TPBG: Need to be able to use different Quadrature schemes with different bases? A - No use highest quadrature scheme for all directions
1149  !!TODO:: Check whether quadrature scheme being used is suffient to interpolate highest order basis function
1150  !!Q - TPBG: Need to be able to use different Interpolation for Geometric & Dependent field?
1151  IF(ASSOCIATED(equations_set)) THEN
1152  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1153  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1154  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1155  CALL flagerror("Equations set specification must have three entries for a linear elasticity type equations set.", &
1156  & err,error,*999)
1157  END IF
1158  equations=>equations_set%EQUATIONS
1159  IF(ASSOCIATED(equations)) THEN
1160  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
1161  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
1162  !FIBRE_FIELD=>EQUATIONS%INTERPOLATION%FIBRE_FIELD
1163  equations_matrices=>equations%EQUATIONS_MATRICES
1164  equations_matrix=>equations_matrices%LINEAR_MATRICES%MATRICES(1)%PTR
1165  rhs_vector=>equations_matrices%RHS_VECTOR
1166  equations_mapping=>equations%EQUATIONS_MAPPING
1167  linear_mapping=>equations_mapping%LINEAR_MAPPING
1168  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
1169  field_var_type=field_variable%VARIABLE_TYPE
1170  !Note that the dimension/number of components for FIELD_U_VARIABLE_TYPE has to be the same as the FIELD_DELUDELN_VARIABLE_TYPE
1171  !& Number of Geometric field components = number of dependent field component
1172  number_of_dependent_components=geometric_field%VARIABLE_TYPE_MAP(1)%ptr%NUMBER_OF_COMPONENTS
1173  !NUMBER_OF_GEOMETRIC_COMPONENTS=DEPENDENT_FIELD%VARIABLE_TYPE_MAP(1)%ptr%NUMBER_OF_COMPONENTS
1174  !!TODO:: Use highest interpolation scheme's guass points. Warn if Gauss Points insufficient
1175  !Create an array of Bases with each component
1176  DO ns=1,number_of_dependent_components
1177  mesh_component=dependent_field%VARIABLE_TYPE_MAP(1)%ptr%COMPONENTS(ns)%mesh_component_number
1178  dependent_bases(ns)%PTR=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component)%PTR% &
1179  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1180  dependent_bases_ep(ns)=dependent_bases(ns)%PTR%NUMBER_OF_ELEMENT_PARAMETERS
1181  quadrature_schemes(ns)%PTR=>dependent_bases(ns)%PTR%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1182  ENDDO
1183  number_of_xi = dependent_bases(1)%PTR%NUMBER_OF_XI
1184  total_dependent_basis_ep = sum(dependent_bases_ep(1:number_of_xi))
1185  !DO ns=1,NUMBER_OF_GEOMETRIC_COMPONENTS
1186  ! MESH_COMPONENT=DEPENDENT_FIELD%VARIABLE_TYPE_MAP(1)%ptr%COMPONENTS(ns)%mesh_component_number
1187  ! GEOMETRIC_BASES(ns)%PTR=>GEOMETRIC_FIELD%DECOMPOSITION%DOMAIN(MESH_COMPONENT)%PTR% &
1188  ! & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS
1189  ! GEOMETRIC_BASES_EP(ns)=GEOMETRIC_BASES(ns)%PTR%NUMBER_OF_ELEMENT_PARAMETERS
1190  !ENDDO
1191  SELECT CASE(equations_set%SPECIFICATION(3))
1192  !
1193  !ONE, TWO & THREE DIMENSIONAL LINEAR ELASTICITY
1194  !
1195  CASE(equations_set_three_dimensional_subtype,equations_set_two_dimensional_plane_stress_subtype, &
1196  & equations_set_two_dimensional_plane_strain_subtype,equations_set_one_dimensional_subtype)
1197  !//
1198  !Parameters for number of off diagonal stress/strain terms for a given number of xi directions and order of calculation for shear terms
1199  !These parameters do not change for 1D,2D,3D Linear Elasticity
1200  off_diag_comp = (/0,1,3/)
1201  off_diag_dep_var(1,1,:) = (/1,1,2/)
1202  off_diag_dep_var(1,2,:) = (/2,3,3/)
1203  off_diag_dep_var(2,1,:) = off_diag_dep_var(1,2,:)
1204  off_diag_dep_var(2,2,:) = off_diag_dep_var(1,1,:)
1205  !//
1206  diag_sub_mat_loc(:) = (/0,dependent_bases_ep(1),sum(dependent_bases_ep(1:2))/)
1207  off_diag_sub_mat_loc(1,:) = (/0,0,dependent_bases_ep(1)/)
1208  off_diag_sub_mat_loc(2,:) = (/dependent_bases_ep(1),diag_sub_mat_loc(3),diag_sub_mat_loc(3)/)
1209 
1210  IF(equations_matrix%UPDATE_MATRIX) THEN
1211  !Get the geometric, fibre & material field interpolation parameters
1212  geometric_interpolation_parameters=>equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%PTR
1213  !FIBRE_INTERPOLATION_PARAMETERS=>EQUATIONS%INTERPOLATION%FIBRE_INTERP_PARAMETERS
1214  materials_interpolation_parameters=>equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS(field_u_variable_type)%PTR
1215  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1216  & geometric_interpolation_parameters,err,error,*999)
1217  !CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, &
1218  ! & FIBRE_INTERPOLATION_PARAMETERS,ERR,ERROR,*999)
1219  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1220  & materials_interpolation_parameters,err,error,*999)
1221  geometric_interp_point_metrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
1222  materials_interp_point=>equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR
1223  !Loop over gauss points & integrate upper triangular portion of Stiffness matrix
1224  DO ng=1,quadrature_schemes(1)%PTR%NUMBER_OF_GAUSS !Gauss point index
1225  !Interpolate geometric, fibre and material fields at gauss points & calculate geometric field metrics
1226  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
1227  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
1228  !CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,EQUATIONS%INTERPOLATION% &
1229  ! & FIBRE_INTERP_POINT,ERR,ERROR,*999)
1230  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,materials_interp_point,err,error,*999)
1231  !!TODO:: Add option to only evaluate required metrics
1232  CALL field_interpolated_point_metrics_calculate(number_of_xi,geometric_interp_point_metrics,err,error,*999)
1233  !Calculate JRWG.
1234  jrwg=quadrature_schemes(1)%PTR%GAUSS_WEIGHTS(ng)*geometric_interp_point_metrics%JACOBIAN
1235  DO xi=1,number_of_xi
1236  dphidx_comp(xi)%DPHIDX = 0.0_dp
1237  DO ns=1,dependent_bases_ep(xi)
1238  DO mi=1,number_of_xi
1239  DO ni=1,number_of_xi
1240  dphidx_comp(xi)%DPHIDX(ns,mi) = dphidx_comp(xi)%DPHIDX(ns,mi)+geometric_interp_point_metrics%DXI_DX(mi,ni)* &
1241  & quadrature_schemes(xi)%PTR%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
1242  ENDDO !ni
1243  ENDDO !mi
1244  ENDDO !ns
1245  ENDDO !xi
1246  !CALL COORDINATE_MATERIAL_COORDINATE_SYSTEM_CALCULATE(EQUATIONS%INTERPOLATION%GEOMETRIC_INTERP_POINT, &
1247  ! EQUATIONS%INTERPOLATION%FIBRE_INTERP_POINT,DXDNU,ERR,ERROR,*999)
1248  !Create Linear Elasticity Tensor C
1249  CALL linear_elasticity_tensor(equations_set%SPECIFICATION(3),materials_interp_point,c,err,error,*999)
1250  !Store Elasticity Tensor diagonal & off diagonal stress coefficients
1251  jrwg_diag_c(3,:) = (/jrwg*c(4,4),jrwg*c(5,5),jrwg*c(3,3)/)
1252  jrwg_diag_c(2,:) = (/jrwg*c(6,6),jrwg*c(2,2),jrwg_diag_c(3,2)/)
1253  jrwg_diag_c(1,:) = (/jrwg*c(1,1),jrwg_diag_c(2,1),jrwg_diag_c(3,1)/)
1254  jrwg_off_diag_c(1,:) = (/jrwg*c(1,2),jrwg*c(1,3),jrwg*c(2,3)/)
1255  jrwg_off_diag_c(2,:) = (/jrwg*c(6,6),jrwg*c(4,4),jrwg*c(5,5)/)
1256  !Construct Element Matrix Diagonal Terms
1257  DO xi=1,number_of_xi
1258  DO ns=1,dependent_bases_ep(xi)
1259  DO ms=ns,dependent_bases_ep(xi)
1260  equations_matrix%ELEMENT_MATRIX%MATRIX(diag_sub_mat_loc(xi)+ns,diag_sub_mat_loc(xi)+ms) = &
1261  & equations_matrix%ELEMENT_MATRIX%MATRIX(diag_sub_mat_loc(xi)+ns,diag_sub_mat_loc(xi)+ms) + &
1262  & dot_product(dphidx_comp(xi)%DPHIDX(ns,1:number_of_xi)*dphidx_comp(xi)%DPHIDX(ms,1:number_of_xi), &
1263  & jrwg_diag_c(xi,1:number_of_xi))
1264  ENDDO !ms
1265  ENDDO !ns
1266  ENDDO !xi
1267  !Construct Element Matrix Off-Diagonal Terms
1268  DO xi=1,off_diag_comp(number_of_xi)
1269  DO ns=1,dependent_bases_ep(off_diag_dep_var(1,1,xi))
1270  DO ms=1,dependent_bases_ep(off_diag_dep_var(1,2,xi))
1271  equations_matrix%ELEMENT_MATRIX%MATRIX(off_diag_sub_mat_loc(1,xi)+ns,off_diag_sub_mat_loc(2,xi)+ms) = &
1272  & equations_matrix%ELEMENT_MATRIX%MATRIX(off_diag_sub_mat_loc(1,xi)+ns,off_diag_sub_mat_loc(2,xi)+ms)+ &
1273  & dot_product(dphidx_comp(off_diag_dep_var(1,1,xi))%DPHIDX(ns,off_diag_dep_var(1,:,xi))* &
1274  & dphidx_comp(off_diag_dep_var(1,2,xi))%DPHIDX(ms,off_diag_dep_var(2,:,xi)),jrwg_off_diag_c(:,xi))
1275  ENDDO !ms
1276  ENDDO !ns
1277  ENDDO !xi
1278 
1279  !Below is the full form of constructing the off-Diagonal terms. This will be documented in the linear elasticity equation set page on doxygen for clarity
1280 
1281  !Expanding the DOT_PRODUCT terms
1282 
1283  !OFF_DIAG_DEP_VAR(1,:) = (/1,1,2/)
1284  !OFF_DIAG_DEP_VAR(2,:) = (/2,3,3/)
1285  ! DO xi=1,OFF_DIAG_COMP(NUMBER_OF_XI)
1286  ! DO ns=1,DEPENDENT_BASES_EP(OFF_DIAG_DEP_VAR(1,1,xi))
1287  ! DO ms=1,DEPENDENT_BASES_EP(OFF_DIAG_DEP_VAR(1,2,xi))
1288  ! EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(OFF_DIAG_SUB_MAT_LOC(1,xi)+ns,OFF_DIAG_SUB_MAT_LOC(2,xi)+ms) = &
1289  ! & EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(OFF_DIAG_SUB_MAT_LOC(1,xi)+ns,OFF_DIAG_SUB_MAT_LOC(2,xi)+ms)+ &
1290  ! & JRWG_OFF_DIAG_C(1,xi)*DPHIDX_COMP(OFF_DIAG_DEP_VAR(1,xi))%DPHIDX(ns,OFF_DIAG_DEP_VAR(1,xi))* &
1291  ! & DPHIDX_COMP(OFF_DIAG_DEP_VAR(2,xi))%DPHIDX(ms,OFF_DIAG_DEP_VAR(2,xi)) + &
1292  ! & JRWG_OFF_DIAG_C(2,xi)*DPHIDX_COMP(OFF_DIAG_DEP_VAR(1,xi))%DPHIDX(ns,OFF_DIAG_DEP_VAR(2,xi))* &
1293  ! & DPHIDX_COMP(OFF_DIAG_DEP_VAR(2,xi))%DPHIDX(ms,OFF_DIAG_DEP_VAR(1,xi))
1294  ! ENDDO !ms
1295  ! ENDDO !ns
1296  ! ENDDO !xi
1297 
1298  ! Expanding the xi loop above
1299 
1300 ! DO ns=1,DEPENDENT_BASES_EP(1)
1301 ! DO ms=1,DEPENDENT_BASES_EP(2)
1302 ! EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns,ms+DEPENDENT_BASES_EP(1)) = &
1303 ! & EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns,ms+DEPENDENT_BASES_EP(1)) + &
1304 ! & JRWG*C(1,2)*DPHIDX_COMP(1)%DPHIDX(ns,1)*DPHIDX_COMP(2)%DPHIDX(ms,2) + &
1305 ! & JRWG*C(6,6)*DPHIDX_COMP(1)%DPHIDX(ns,2)*DPHIDX_COMP(2)%DPHIDX(ms,1)
1306 ! ENDDO !ns
1307 ! ENDDO !ms
1308 ! DO ns=1,DEPENDENT_BASES_EP(1)
1309 ! DO ms=1,DEPENDENT_BASES_EP(3)
1310 ! EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns,ms+DEPENDENT_BASES_EP(1)+DEPENDENT_BASES_EP(2)) = &
1311 ! & EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns,ms+DEPENDENT_BASES_EP(1)+DEPENDENT_BASES_EP(2)) + &
1312 ! & JRWG*C(1,3)*DPHIDX_COMP(1)%DPHIDX(ns,1)*DPHIDX_COMP(3)%DPHIDX(ms,3) + &
1313 ! & JRWG*C(4,4)*DPHIDX_COMP(1)%DPHIDX(ns,3)*DPHIDX_COMP(3)%DPHIDX(ms,1)
1314 ! ENDDO !ns
1315 ! ENDDO !ms
1316 ! DO ns=1,DEPENDENT_BASES_EP(2)
1317 ! DO ms=1,DEPENDENT_BASES_EP(3)
1318 ! EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns+DEPENDENT_BASES_EP(1),ms+DEPENDENT_BASES_EP(1)+DEPENDENT_BASES_EP(2)) = &
1319 ! & EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX(ns+DEPENDENT_BASES_EP(1),ms+DEPENDENT_BASES_EP(1)+DEPENDENT_BASES_EP(2)) + &
1320 ! & JRWG*C(2,3)*DPHIDX_COMP(2)%DPHIDX(ns,2)*DPHIDX_COMP(3)%DPHIDX(ms,3) + &
1321 ! & JRWG*C(5,5)*DPHIDX_COMP(2)%DPHIDX(ns,3)*DPHIDX_COMP(3)%DPHIDX(ms,2)
1322 ! ENDDO !ns
1323 ! ENDDO !ms
1324  ENDDO !ng
1325  !If Plane Stress/Strain problem multiply equation matrix by thickness
1326  IF(equations_set%SPECIFICATION(3) == equations_set_two_dimensional_plane_stress_subtype .OR. &
1327  & equations_set%SPECIFICATION(3) == equations_set_two_dimensional_plane_strain_subtype .OR. &
1328  & equations_set%SPECIFICATION(3) == equations_set_one_dimensional_subtype) THEN
1329  DO mhs=1,total_dependent_basis_ep
1330  DO nhs=mhs,total_dependent_basis_ep
1331  !!TODO::Bring 2D plane stress/strain element thickness in through a field - element constant when it can be exported by field i/o. Currently brought in through material field (Temporary)
1332  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
1333  & materials_interp_point%values(1,1)
1334  ENDDO !nhs
1335  ENDDO !mhs
1336  ENDIF
1337  ENDIF
1338 
1339  !!TODO:: Is this RHS Vector update required? find out/check - RHS not used - BC are prescribed during assembling eg update RHS only when BC change - stiffness matrix should be the same
1340  IF(rhs_vector%UPDATE_VECTOR) THEN
1341  rhs_vector%ELEMENT_VECTOR%VECTOR=0.0_dp
1342  ENDIF
1343 
1344  !Scale factor adjustment, Application of Scale factors is symmetric
1345  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
1346  dependent_interpolation_parameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR
1347  CALL field_interpolationparametersscalefactorselementget(element_number,dependent_interpolation_parameters, &
1348  & err,error,*999)
1349  DO xi=1,number_of_xi
1350  sf(diag_sub_mat_loc(xi)+1:sum(dependent_bases_ep(1:xi)))=dependent_interpolation_parameters%SCALE_FACTORS(:,xi)
1351  ENDDO !xi
1352  DO mhs=1,total_dependent_basis_ep
1353  IF(equations_matrix%UPDATE_MATRIX) THEN
1354  DO nhs=mhs,total_dependent_basis_ep
1355  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)*sf(mhs)*sf(nhs)
1356  ENDDO !nhs
1357  ENDIF
1358  !!TODO:: Check if RHS update required for Linear Elasticity ie is the RHS the force terms but they are set during assembling and not here?
1359  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)*sf(mhs)
1360  ENDDO !mhs
1361  ENDIF
1362 
1363  IF(equations_matrix%UPDATE_MATRIX) THEN
1364  !Transpose upper triangular portion of Stiffness matrix to give lower triangular portion. Has to be done after scale factors are applied
1365  !!TODO:: Use symmetric linear equation solver or alternatively traspose to give full matrix when asemmbling or when creating solver matrices
1366  !!TODO:: Better to use SIZE(EQUATIONS_MATRIX%ELEMENT_MATRIX%MATRIX,1) as apposed to TOTAL_DEPENDENT_BASIS_EP? Is the size re-calculated at end of every loop?
1367  DO mhs=2,total_dependent_basis_ep
1368  DO nhs=1,mhs-1
1369  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = equations_matrix%ELEMENT_MATRIX%MATRIX(nhs,mhs)
1370  ENDDO !nhs
1371  ENDDO !mhs
1372  ENDIF
1373 
1374  CASE(equations_set_plate_subtype)
1375  CALL flagerror("Not implemented.",err,error,*999)
1376  CASE(equations_set_shell_subtype)
1377  CALL flagerror("Not implemented.",err,error,*999)
1378  CASE DEFAULT
1379  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1380  & " is not valid for a Linear Elasticity equation type of a Elasticty equations set class."
1381  CALL flagerror(local_error,err,error,*999)
1382  END SELECT
1383  ELSE
1384  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1385  ENDIF
1386  ELSE
1387  CALL flagerror("Equations set is not associated.",err,error,*999)
1388  ENDIF
1389 
1390  exits("LINEAR_ELASTICITY_FINITE_ELEMENT_CALCULATE")
1391  RETURN
1392 999 errorsexits("LINEAR_ELASTICITY_FINITE_ELEMENT_CALCULATE",err,error)
1393  RETURN 1
1394  END SUBROUTINE linear_elasticity_finite_element_calculate
1395 
1396  !
1397  !================================================================================================================================
1398  !
1399 
1401  SUBROUTINE linear_elasticity_tensor(EQUATIONS_SET_SUBTYPE,MATERIALS_INTERPOLATED_POINT,ELASTICITY_TENSOR,ERR,ERROR,*)
1402 
1403  !Argument variables
1404  INTEGER(INTG), INTENT(IN) :: EQUATIONS_SET_SUBTYPE
1405  TYPE(field_interpolated_point_type), POINTER :: MATERIALS_INTERPOLATED_POINT
1406  REAL(DP), INTENT(OUT) :: ELASTICITY_TENSOR(:,:)
1407  INTEGER(INTG), INTENT(OUT) :: ERR
1408  TYPE(varying_string), INTENT(OUT) :: ERROR
1409 
1410  !Local Variables
1411  REAL(DP) :: E1,E2,E3,v13,v23,v12,v31,v32,v21,gama
1412  REAL(DP) :: C11,C22,C33,C12,C13,C23,C21,C31,C32,C44,C55,C66
1413  TYPE(varying_string) :: LOCAL_ERROR
1414 
1415  enters("LINEAR_ELASTICITY_TENSOR",err,error,*999)
1416  elasticity_tensor=0.0_dp
1417  SELECT CASE(equations_set_subtype)
1418  !Note: Fortran uses column major format for arrays.
1419  CASE(equations_set_three_dimensional_subtype)
1420  !General Orthotropic 3D Linear Elasticity Tensor
1421  e1 = materials_interpolated_point%values(1,1)
1422  e2 = materials_interpolated_point%values(2,1)
1423  e3 = materials_interpolated_point%values(3,1)
1424  v13 = materials_interpolated_point%values(4,1)
1425  v23 = materials_interpolated_point%values(5,1)
1426  v12 = materials_interpolated_point%values(6,1)
1427  v31 = v13
1428  v32 = v23
1429  v21 = v12
1430  gama = 1.0_dp/(1.0_dp-v12*v21-v23*v32-v31*v13-2.0_dp*v21*v32*v13)
1431  c11 = e1*(1.0_dp-v23*v32)*gama
1432  c22 = e2*(1.0_dp-v13*v31)*gama
1433  c33 = e3*(1.0_dp-v12*v21)*gama
1434  c12 = e1*(v21+v31*v23)*gama ! = E2*(v12+v32*v13)*gama
1435  c13 = e1*(v31+v21*v32)*gama ! = E3*(v13+v12*v23)*gama
1436  c23 = e2*(v32+v12*v31)*gama ! = E3*(v23+v21*v13)*gama
1437  c21 = c12
1438  c31 = c13
1439  c32 = c23
1440  c44 = e2/(2.0_dp*(1.0_dp+v23)) != G23
1441  c55 = e1/(2.0_dp*(1.0_dp+v13)) != G13
1442  c66 = e3/(2.0_dp*(1.0_dp+v12)) != G12
1443  elasticity_tensor(1:6,1)=(/c11,c21,c31,0.0_dp,0.0_dp,0.0_dp/)
1444  elasticity_tensor(1:6,2)=(/c12,c22,c32,0.0_dp,0.0_dp,0.0_dp/)
1445  elasticity_tensor(1:6,3)=(/c13,c23,c33,0.0_dp,0.0_dp,0.0_dp/)
1446  elasticity_tensor(4,4)=c44
1447  elasticity_tensor(5,5)=c55
1448  elasticity_tensor(6,6)=c66
1449  CASE(equations_set_two_dimensional_plane_stress_subtype)
1450  !Plane Stress Isotropic Elasticity Tensor
1451  e1 = materials_interpolated_point%values(2,1)
1452  v12 = materials_interpolated_point%values(3,1)
1453  v21 = v12
1454  gama = 1.0_dp/(1.0_dp-v12*v21)
1455  c11 = e1*gama
1456  c22 = c11
1457  c12 = c11*v21
1458  c21 = c12
1459  c66 = e1/(2.0_dp*(1.0_dp+v12)) != G12
1460  elasticity_tensor(1,1)=c11
1461  elasticity_tensor(1,2)=c21
1462  elasticity_tensor(2,1)=c21
1463  elasticity_tensor(2,2)=c22
1464  elasticity_tensor(6,6)=c66
1465  CASE(equations_set_two_dimensional_plane_strain_subtype)
1466  !Plane Strain Isotropic Linear Elasticity Tensor
1467  e1 = materials_interpolated_point%values(2,1)
1468  e2 = e1
1469  v12 = materials_interpolated_point%values(3,1)
1470  v21 = v12
1471  gama = 1.0_dp/(1.0_dp-v12-v21)
1472  c11 = e1*gama*(1.0_dp-v12)/(1.0_dp+v12)
1473  c22 = e2*gama*(1.0_dp-v21)/(1.0_dp+v21)
1474  c12 = c22*v12
1475  c21 = c12
1476  c66 = e1/(2.0_dp*(1.0_dp+v12)) != G12
1477  elasticity_tensor(1,1)=c11
1478  elasticity_tensor(1,2)=c21
1479  elasticity_tensor(2,1)=c21
1480  elasticity_tensor(2,2)=c22
1481  elasticity_tensor(6,6)=c66
1482  CASE(equations_set_one_dimensional_subtype)
1483  !Plane Strain Isotropic Linear Elasticity Tensor
1484  e1 = materials_interpolated_point%values(2,1)
1485  c11 = e1
1486  elasticity_tensor(1,1)=c11
1487  CASE(equations_set_plate_subtype)
1488  CALL flagerror("Not implemented.",err,error,*999)
1489  CASE(equations_set_shell_subtype)
1490  CALL flagerror("Not implemented.",err,error,*999)
1491  CASE DEFAULT
1492  local_error="Equations set subtype "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
1493  & " is not valid for a Linear Elasticity equation type of a Elasticty equations set class."
1494  CALL flagerror(local_error,err,error,*999)
1495  END SELECT
1496 
1497  exits("LINEAR_ELASTICITY_TENSOR")
1498  RETURN
1499 999 errorsexits("LINEAR_ELASTICITY_TENSOR",err,error)
1500  RETURN 1
1501  END SUBROUTINE linear_elasticity_tensor
1502 
1503  !
1504  !================================================================================================================================
1505  !
1506 
1508  SUBROUTINE linear_elasticity_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
1509 
1510  !Argument variables
1511  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1512  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
1513  INTEGER(INTG), INTENT(OUT) :: ERR
1514  TYPE(varying_string), INTENT(OUT) :: ERROR
1515  !Local Variables
1516  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE, &
1517  & NUMBER_OF_COMPONENTS,NUMBER_OF_DIMENSIONS
1518  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
1519  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
1520  TYPE(equations_type), POINTER :: EQUATIONS
1521  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1522  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1523  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
1524  TYPE(varying_string) :: LOCAL_ERROR
1525 
1526  enters("LINEAR_ELASTICITY_EQUATIONS_SET_SETUP",err,error,*999)
1527 
1528  NULLIFY(equations)
1529  NULLIFY(equations_mapping)
1530  NULLIFY(equations_matrices)
1531  NULLIFY(geometric_decomposition)
1532 
1533  IF(ASSOCIATED(equations_set)) THEN
1534  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1535  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1536  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1537  CALL flagerror("Equations set specification must have three entries for a linear elasticity type equations set.", &
1538  & err,error,*999)
1539  END IF
1540 
1541  !!TODO:: Update all these so there is a default setup that is valid for 1D,2D & 3D Linear Elasticity
1542  SELECT CASE(equations_set%SPECIFICATION(3))
1543  !
1544  ! THREE DIMENSIONAL ELASTICITY
1545  !
1546  CASE(equations_set_three_dimensional_subtype)
1547  SELECT CASE(equations_set_setup%SETUP_TYPE)
1548  CASE(equations_set_setup_initial_type)
1549  SELECT CASE(equations_set_setup%ACTION_TYPE)
1550  CASE(equations_set_setup_start_action)
1551  !Default to FEM solution
1552  CALL linearelasticity_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
1553  & err,error,*999)
1554  CASE(equations_set_setup_finish_action)
1555 !!TODO: Check valid setup
1556  CASE DEFAULT
1557  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1558  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1559  & " is invalid for a linear elasticity equation."
1560  CALL flagerror(local_error,err,error,*999)
1561  END SELECT
1562  CASE(equations_set_setup_geometry_type)
1563  !Do nothing???
1564  CASE(equations_set_setup_dependent_type)
1565  SELECT CASE(equations_set_setup%ACTION_TYPE)
1566  CASE(equations_set_setup_start_action)
1567  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1568  !Create the auto created dependent field
1569  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1570  & dependent_field,err,error,*999)
1571  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1572  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1573  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1574  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1575  & err,error,*999)
1576  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1577  & geometric_field,err,error,*999)
1578  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
1579  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
1580  & field_deludeln_variable_type/),err,error,*999)
1581  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1582  & field_vector_dimension_type,err,error,*999)
1583  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1584  & field_vector_dimension_type,err,error,*999)
1585  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1586  & field_dp_type,err,error,*999)
1587  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1588  & field_dp_type,err,error,*999)
1589  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1590  & number_of_dimensions,err,error,*999)
1591  number_of_components=number_of_dimensions
1592  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1593  & number_of_components,err,error,*999)
1594  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1595  & number_of_components,err,error,*999)
1596  !Default to the geometric interpolation setup
1597  DO component_idx=1,number_of_dimensions
1598  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1599  & component_idx,geometric_mesh_component,err,error,*999)
1600  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1601  & component_idx,geometric_mesh_component,err,error,*999)
1602  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1603  & component_idx,geometric_mesh_component,err,error,*999)
1604  ENDDO !component_idx
1605  SELECT CASE(equations_set%SOLUTION_METHOD)
1606  CASE(equations_set_fem_solution_method)
1607  DO component_idx=1,number_of_components
1608  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1609  & component_idx,field_node_based_interpolation,err,error,*999)
1610  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1611  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
1612  ENDDO !component_idx
1613  !Default the scaling to the geometric field scaling
1614  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1615  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1616  CASE(equations_set_bem_solution_method)
1617  CALL flagerror("Not implemented.",err,error,*999)
1618  CASE(equations_set_fd_solution_method)
1619  CALL flagerror("Not implemented.",err,error,*999)
1620  CASE(equations_set_fv_solution_method)
1621  CALL flagerror("Not implemented.",err,error,*999)
1622  CASE(equations_set_gfem_solution_method)
1623  CALL flagerror("Not implemented.",err,error,*999)
1624  CASE(equations_set_gfv_solution_method)
1625  CALL flagerror("Not implemented.",err,error,*999)
1626  CASE DEFAULT
1627  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1628  & " is invalid."
1629  CALL flagerror(local_error,err,error,*999)
1630  END SELECT
1631  ELSE
1632  !Check the user specified field
1633  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1634  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1635  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1636  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
1637  & err,error,*999)
1638  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1639  & err,error,*999)
1640  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
1641  & err,error,*999)
1642  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1643  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
1644  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1645  & number_of_dimensions,err,error,*999)
1646  number_of_components=number_of_dimensions
1647  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
1648  & err,error,*999)
1649  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components, &
1650  & err,error,*999)
1651  SELECT CASE(equations_set%SOLUTION_METHOD)
1652  CASE(equations_set_fem_solution_method)
1653  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1654  & field_node_based_interpolation,err,error,*999)
1655  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1656  & field_node_based_interpolation,err,error,*999)
1657  CASE(equations_set_bem_solution_method)
1658  CALL flagerror("Not implemented.",err,error,*999)
1659  CASE(equations_set_fd_solution_method)
1660  CALL flagerror("Not implemented.",err,error,*999)
1661  CASE(equations_set_fv_solution_method)
1662  CALL flagerror("Not implemented.",err,error,*999)
1663  CASE(equations_set_gfem_solution_method)
1664  CALL flagerror("Not implemented.",err,error,*999)
1665  CASE(equations_set_gfv_solution_method)
1666  CALL flagerror("Not implemented.",err,error,*999)
1667  CASE DEFAULT
1668  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1669  & " is invalid."
1670  CALL flagerror(local_error,err,error,*999)
1671  END SELECT
1672  ENDIF
1673  CASE(equations_set_setup_finish_action)
1674  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1675  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1676  ENDIF
1677  CASE DEFAULT
1678  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1679  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1680  & " is invalid for a linear elasticity equation"
1681  CALL flagerror(local_error,err,error,*999)
1682  END SELECT
1683  CASE(equations_set_setup_materials_type)
1684  SELECT CASE(equations_set_setup%ACTION_TYPE)
1685  CASE(equations_set_setup_start_action)
1686  equations_materials=>equations_set%MATERIALS
1687  IF(ASSOCIATED(equations_materials)) THEN
1688  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1689  !Default to the general 3D orthotropic material
1690  !Create the auto created materials field
1691  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
1692  & materials_field,err,error,*999)
1693  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1694  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
1695  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1696  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
1697  & err,error,*999)
1698  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1699  & geometric_field,err,error,*999)
1700  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
1701  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
1702  & err,error,*999)
1703  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1704  & field_vector_dimension_type,err,error,*999)
1705  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1706  & field_dp_type,err,error,*999)
1707  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1708  & 6,err,error,*999)
1709  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1710  & 1,geometric_component_number,err,error,*999)
1711  DO component_idx=1,6
1712  !Default to to the first geometric component with constant interpolation
1713  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1714  & component_idx,geometric_component_number,err,error,*999)
1715  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1716  & component_idx,field_constant_interpolation,err,error,*999)
1717  ENDDO !component_idx
1718  !Default the field scaling to that of the geometric field
1719  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1720  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1721  ELSE
1722  !Check the user specified field
1723  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1724  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1725  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1726  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1727  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1728  & err,error,*999)
1729  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1730  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,6,err,error,*999)
1731  ENDIF
1732  ELSE
1733  CALL flagerror("Equations materials is not associated.",err,error,*999)
1734  ENDIF
1735  CASE(equations_set_setup_finish_action)
1736  equations_materials=>equations_set%MATERIALS
1737  IF(ASSOCIATED(equations_materials)) THEN
1738  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1739  !Finish creating the materials field
1740  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1741  !Set the default values for the materials field
1742  DO component_idx=1,3
1743  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1744  & field_values_set_type,component_idx,30.0e6_dp,err,error,*999)
1745  ENDDO !component_idx
1746  DO component_idx=4,6
1747  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1748  & field_values_set_type,component_idx,0.25_dp,err,error,*999)
1749  ENDDO !component_idx
1750  ENDIF
1751  ELSE
1752  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1753  ENDIF
1754  CASE DEFAULT
1755  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1756  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1757  & " is invalid for a linear elasticity equation."
1758  CALL flagerror(local_error,err,error,*999)
1759  END SELECT
1760  CASE(equations_set_setup_source_type)
1761  SELECT CASE(equations_set_setup%ACTION_TYPE)
1762  CASE(equations_set_setup_start_action)
1763  !Do nothing
1764  CASE(equations_set_setup_finish_action)
1765  !Do nothing
1766  !? Maybe set finished flag????
1767  CASE DEFAULT
1768  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1769  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1770  & " is invalid for a linear elasticity equation."
1771  CALL flagerror(local_error,err,error,*999)
1772  END SELECT
1773 
1774  CASE(equations_set_setup_analytic_type)
1775  SELECT CASE(equations_set_setup%ACTION_TYPE)
1776  CASE(equations_set_setup_start_action)
1777  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1778  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1779  IF(ASSOCIATED(dependent_field)) THEN
1780  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
1781  IF(ASSOCIATED(geometric_field)) THEN
1782  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
1783  !List 3 Dimensional Analytic function types currently implemented
1784  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
1785  CASE(equations_set_linear_elasticity_three_dim_1)
1786  !Check that we are in 3D
1787  IF(number_of_dimensions/=3) THEN
1788  local_error="The number of geometric dimensions of "// &
1789  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1790  & " is invalid. The analytic function type of "// &
1791  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1792  & " requires that there be 3 geometric dimensions."
1793  CALL flagerror(local_error,err,error,*999)
1794  ENDIF
1795  !Create analytic field if required
1796  !Set analtyic function type
1797  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_linear_elasticity_three_dim_1
1798  CASE(equations_set_linear_elasticity_three_dim_2)
1799  !Check that we are in 3D
1800  IF(number_of_dimensions/=3) THEN
1801  local_error="The number of geometric dimensions of "// &
1802  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1803  & " is invalid. The analytic function type of "// &
1804  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1805  & " requires that there be 3 geometric dimensions."
1806  CALL flagerror(local_error,err,error,*999)
1807  ENDIF
1808  !Create analytic field if required
1809  !Set analtyic function type
1810  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_linear_elasticity_three_dim_2
1811  CASE DEFAULT
1812  local_error="The specified analytic function type of "// &
1813  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1814  & " is invalid for a standard Linear Elasticity equation."
1815  CALL flagerror(local_error,err,error,*999)
1816  END SELECT
1817  ELSE
1818  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1819  ENDIF
1820  ELSE
1821  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1822  ENDIF
1823  ELSE
1824  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1825  ENDIF
1826  CASE(equations_set_setup_finish_action)
1827  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
1828  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
1829  IF(ASSOCIATED(analytic_field)) THEN
1830  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
1831  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1832  ENDIF
1833  ENDIF
1834  ELSE
1835  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1836  ENDIF
1837  CASE DEFAULT
1838  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1839  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1840  & " is invalid for a standard Linear Elasticity equation."
1841  CALL flagerror(local_error,err,error,*999)
1842  END SELECT
1843 
1844  CASE(equations_set_setup_equations_type)
1845  SELECT CASE(equations_set_setup%ACTION_TYPE)
1846  CASE(equations_set_setup_start_action)
1847  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1848  !Create the equations
1849  CALL equations_create_start(equations_set,equations,err,error,*999)
1850  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
1851  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
1852  ELSE
1853  CALL flagerror("Equations set dependent field has not bee finished.",err,error,*999)
1854  ENDIF
1855  CASE(equations_set_setup_finish_action)
1856  SELECT CASE(equations_set%SOLUTION_METHOD)
1857  CASE(equations_set_fem_solution_method)
1858  !Finish the equations creation
1859  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1860  CALL equations_create_finish(equations,err,error,*999)
1861  !Create the equations mapping.
1862  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1863  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
1864  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
1865  & err,error,*999)
1866  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1867  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1868  !Create the equations matrices
1869  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1870  SELECT CASE(equations%SPARSITY_TYPE)
1871  CASE(equations_matrices_full_matrices)
1872  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
1873  & err,error,*999)
1874  CASE(equations_matrices_sparse_matrices)
1875  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
1876  & err,error,*999)
1877  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
1878  & err,error,*999)
1879  CASE DEFAULT
1880  local_error="The equations matrices sparsity type of "// &
1881  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1882  CALL flagerror(local_error,err,error,*999)
1883  END SELECT
1884  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1885  CASE(equations_set_bem_solution_method)
1886  CALL flagerror("Not implemented.",err,error,*999)
1887  CASE(equations_set_fd_solution_method)
1888  CALL flagerror("Not implemented.",err,error,*999)
1889  CASE(equations_set_fv_solution_method)
1890  CALL flagerror("Not implemented.",err,error,*999)
1891  CASE(equations_set_gfem_solution_method)
1892  CALL flagerror("Not implemented.",err,error,*999)
1893  CASE(equations_set_gfv_solution_method)
1894  CALL flagerror("Not implemented.",err,error,*999)
1895  CASE DEFAULT
1896  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1897  & " is invalid."
1898  CALL flagerror(local_error,err,error,*999)
1899  END SELECT
1900  CASE DEFAULT
1901  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1902  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1903  & " is invalid for a linear elasticity equation."
1904  CALL flagerror(local_error,err,error,*999)
1905  END SELECT
1906  CASE DEFAULT
1907  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1908  & " is invalid for a linear elasticity equation."
1909  CALL flagerror(local_error,err,error,*999)
1910  END SELECT
1911 
1912  !
1913  ! TWO DIMENSIONAL PLANE STRESS & PLANE STRAIN ELASTICITY
1914  !
1915  CASE(equations_set_two_dimensional_plane_stress_subtype,equations_set_two_dimensional_plane_strain_subtype)
1916  SELECT CASE(equations_set_setup%SETUP_TYPE)
1917  CASE(equations_set_setup_initial_type)
1918  SELECT CASE(equations_set_setup%ACTION_TYPE)
1919  CASE(equations_set_setup_start_action)
1920  !Default to FEM solution
1921  CALL linearelasticity_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
1922  & err,error,*999)
1923  CASE(equations_set_setup_finish_action)
1924 !!TODO: Check valid setup
1925  CASE DEFAULT
1926  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1927  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1928  & " is invalid for a linear elasticity equation."
1929  CALL flagerror(local_error,err,error,*999)
1930  END SELECT
1931  CASE(equations_set_setup_geometry_type)
1932  !Do nothing???
1933  CASE(equations_set_setup_dependent_type)
1934  SELECT CASE(equations_set_setup%ACTION_TYPE)
1935  CASE(equations_set_setup_start_action)
1936  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1937  !Create the auto created dependent field
1938  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1939  & dependent_field,err,error,*999)
1940  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1941  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1942  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1943  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1944  & err,error,*999)
1945  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1946  & geometric_field,err,error,*999)
1947  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
1948  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
1949  & field_deludeln_variable_type/),err,error,*999)
1950  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1951  & field_vector_dimension_type,err,error,*999)
1952  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1953  & field_vector_dimension_type,err,error,*999)
1954  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1955  & field_dp_type,err,error,*999)
1956  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1957  & field_dp_type,err,error,*999)
1958  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1959  & number_of_dimensions,err,error,*999)
1960  number_of_components=number_of_dimensions
1961  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1962  & number_of_components,err,error,*999)
1963  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1964  & number_of_components,err,error,*999)
1965  !Default to the geometric interpolation setup
1966  DO component_idx=1,number_of_dimensions
1967  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1968  & component_idx,geometric_mesh_component,err,error,*999)
1969  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1970  & component_idx,geometric_mesh_component,err,error,*999)
1971  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1972  & component_idx,geometric_mesh_component,err,error,*999)
1973  ENDDO !component_idx
1974  SELECT CASE(equations_set%SOLUTION_METHOD)
1975  CASE(equations_set_fem_solution_method)
1976  DO component_idx=1,number_of_components
1977  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1978  & component_idx,field_node_based_interpolation,err,error,*999)
1979  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1980  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
1981  ENDDO !component_idx
1982  !Default the scaling to the geometric field scaling
1983  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1984  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1985  CASE(equations_set_bem_solution_method)
1986  CALL flagerror("Not implemented.",err,error,*999)
1987  CASE(equations_set_fd_solution_method)
1988  CALL flagerror("Not implemented.",err,error,*999)
1989  CASE(equations_set_fv_solution_method)
1990  CALL flagerror("Not implemented.",err,error,*999)
1991  CASE(equations_set_gfem_solution_method)
1992  CALL flagerror("Not implemented.",err,error,*999)
1993  CASE(equations_set_gfv_solution_method)
1994  CALL flagerror("Not implemented.",err,error,*999)
1995  CASE DEFAULT
1996  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1997  & " is invalid."
1998  CALL flagerror(local_error,err,error,*999)
1999  END SELECT
2000  ELSE
2001  !Check the user specified field
2002  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2003  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2004  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2005  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
2006  & err,error,*999)
2007  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2008  & err,error,*999)
2009  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
2010  & err,error,*999)
2011  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2012  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2013  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2014  & number_of_dimensions,err,error,*999)
2015  number_of_components=number_of_dimensions
2016  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
2017  & err,error,*999)
2018  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components, &
2019  & err,error,*999)
2020  SELECT CASE(equations_set%SOLUTION_METHOD)
2021  CASE(equations_set_fem_solution_method)
2022  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2023  & field_node_based_interpolation,err,error,*999)
2024  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2025  & field_node_based_interpolation,err,error,*999)
2026  CASE(equations_set_bem_solution_method)
2027  CALL flagerror("Not implemented.",err,error,*999)
2028  CASE(equations_set_fd_solution_method)
2029  CALL flagerror("Not implemented.",err,error,*999)
2030  CASE(equations_set_fv_solution_method)
2031  CALL flagerror("Not implemented.",err,error,*999)
2032  CASE(equations_set_gfem_solution_method)
2033  CALL flagerror("Not implemented.",err,error,*999)
2034  CASE(equations_set_gfv_solution_method)
2035  CALL flagerror("Not implemented.",err,error,*999)
2036  CASE DEFAULT
2037  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2038  & " is invalid."
2039  CALL flagerror(local_error,err,error,*999)
2040  END SELECT
2041  ENDIF
2042  CASE(equations_set_setup_finish_action)
2043  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2044  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2045  ENDIF
2046  CASE DEFAULT
2047  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2048  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2049  & " is invalid for a linear elasticity equation"
2050  CALL flagerror(local_error,err,error,*999)
2051  END SELECT
2052  CASE(equations_set_setup_materials_type)
2053  SELECT CASE(equations_set_setup%ACTION_TYPE)
2054  CASE(equations_set_setup_start_action)
2055  equations_materials=>equations_set%MATERIALS
2056  IF(ASSOCIATED(equations_materials)) THEN
2057  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2058  !Default to the general 3D orthotropic material
2059  !Create the auto created materials field
2060  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
2061  & materials_field,err,error,*999)
2062  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2063  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
2064  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2065  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
2066  & err,error,*999)
2067  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2068  & geometric_field,err,error,*999)
2069  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
2070  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
2071  & err,error,*999)
2072  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2073  & field_vector_dimension_type,err,error,*999)
2074  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2075  & field_dp_type,err,error,*999)
2076  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2077  & 6,err,error,*999)
2078  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2079  & 1,geometric_component_number,err,error,*999)
2080  DO component_idx=1,6
2081  !Default to to the first geometric component with constant interpolation
2082  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2083  & component_idx,geometric_component_number,err,error,*999)
2084  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2085  & component_idx,field_constant_interpolation,err,error,*999)
2086  ENDDO !component_idx
2087  !Default the field scaling to that of the geometric field
2088  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2089  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2090  ELSE
2091  !Check the user specified field
2092  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2093  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2094  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2095  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2096  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2097  & err,error,*999)
2098  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2099  !2 Components for 2D Isotropic Linear Elasticity
2100  !TODO:: Temporarily set to 3 to allow thickness to passed in. Remove once a thickness, element constant field is defined and can be exported/viewed by cmgui
2101  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,3,err,error,*999)
2102  ENDIF
2103  ELSE
2104  CALL flagerror("Equations materials is not associated.",err,error,*999)
2105  ENDIF
2106  CASE(equations_set_setup_finish_action)
2107  equations_materials=>equations_set%MATERIALS
2108  IF(ASSOCIATED(equations_materials)) THEN
2109  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2110  !Finish creating the materials field
2111  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2112  !Set the default values for the materials field
2113  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2114  & field_values_set_type,1,30.0e6_dp,err,error,*999) !Young's Modulus
2115  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2116  & field_values_set_type,2,0.25_dp,err,error,*999) !Poisson's Ratio
2117  ENDIF
2118  ELSE
2119  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2120  ENDIF
2121  CASE DEFAULT
2122  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2123  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2124  & " is invalid for a linear elasticity equation."
2125  CALL flagerror(local_error,err,error,*999)
2126  END SELECT
2127  CASE(equations_set_setup_source_type)
2128  SELECT CASE(equations_set_setup%ACTION_TYPE)
2129  CASE(equations_set_setup_start_action)
2130  !Do nothing
2131  CASE(equations_set_setup_finish_action)
2132  !Do nothing
2133  !? Maybe set finished flag????
2134  CASE DEFAULT
2135  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2136  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2137  & " is invalid for a linear elasticity equation."
2138  CALL flagerror(local_error,err,error,*999)
2139  END SELECT
2140 
2141  CASE(equations_set_setup_analytic_type)
2142  SELECT CASE(equations_set_setup%ACTION_TYPE)
2143  CASE(equations_set_setup_start_action)
2144  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2145  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2146  IF(ASSOCIATED(dependent_field)) THEN
2147  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
2148  IF(ASSOCIATED(geometric_field)) THEN
2149  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
2150  !List 3 Dimensional Analytic function types currently implemented
2151  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
2152  CASE(equations_set_linear_elasticity_two_dim_1)
2153  !Check that we are in 2D
2154  !!TODO:: This check may have been done before
2155  IF(number_of_dimensions/=2) THEN
2156  local_error="The number of geometric dimensions of "// &
2157  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2158  & " is invalid. The analytic function type of "// &
2159  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2160  & " requires that there be 2 geometric dimensions."
2161  CALL flagerror(local_error,err,error,*999)
2162  ENDIF
2163  !Create analytic field if required
2164  !Set analtyic function type
2165  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_linear_elasticity_two_dim_1
2166  CASE DEFAULT
2167  local_error="The specified analytic function type of "// &
2168  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2169  & " is invalid for a standard Linear Elasticity equation."
2170  CALL flagerror(local_error,err,error,*999)
2171  END SELECT
2172  ELSE
2173  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
2174  ENDIF
2175  ELSE
2176  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
2177  ENDIF
2178  ELSE
2179  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2180  ENDIF
2181  CASE(equations_set_setup_finish_action)
2182  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
2183  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
2184  IF(ASSOCIATED(analytic_field)) THEN
2185  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
2186  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2187  ENDIF
2188  ENDIF
2189  ELSE
2190  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
2191  ENDIF
2192  CASE DEFAULT
2193  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2194  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2195  & " is invalid for a standard Linear Elasticity equation."
2196  CALL flagerror(local_error,err,error,*999)
2197  END SELECT
2198 
2199 
2200  CASE(equations_set_setup_equations_type)
2201  SELECT CASE(equations_set_setup%ACTION_TYPE)
2202  CASE(equations_set_setup_start_action)
2203  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2204  !Create the equations
2205  CALL equations_create_start(equations_set,equations,err,error,*999)
2206  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
2207  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2208  ELSE
2209  CALL flagerror("Equations set dependent field has not bee finished.",err,error,*999)
2210  ENDIF
2211  CASE(equations_set_setup_finish_action)
2212  SELECT CASE(equations_set%SOLUTION_METHOD)
2213  CASE(equations_set_fem_solution_method)
2214  !Finish the equations creation
2215  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2216  CALL equations_create_finish(equations,err,error,*999)
2217  !Create the equations mapping.
2218  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2219  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2220  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
2221  & err,error,*999)
2222  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2223  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2224  !Create the equations matrices
2225  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2226  SELECT CASE(equations%SPARSITY_TYPE)
2227  CASE(equations_matrices_full_matrices)
2228  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
2229  & err,error,*999)
2230  CASE(equations_matrices_sparse_matrices)
2231  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
2232  & err,error,*999)
2233  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
2234  & err,error,*999)
2235  CASE DEFAULT
2236  local_error="The equations matrices sparsity type of "// &
2237  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2238  CALL flagerror(local_error,err,error,*999)
2239  END SELECT
2240  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2241  CASE(equations_set_bem_solution_method)
2242  CALL flagerror("Not implemented.",err,error,*999)
2243  CASE(equations_set_fd_solution_method)
2244  CALL flagerror("Not implemented.",err,error,*999)
2245  CASE(equations_set_fv_solution_method)
2246  CALL flagerror("Not implemented.",err,error,*999)
2247  CASE(equations_set_gfem_solution_method)
2248  CALL flagerror("Not implemented.",err,error,*999)
2249  CASE(equations_set_gfv_solution_method)
2250  CALL flagerror("Not implemented.",err,error,*999)
2251  CASE DEFAULT
2252  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2253  & " is invalid."
2254  CALL flagerror(local_error,err,error,*999)
2255  END SELECT
2256  CASE DEFAULT
2257  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2258  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2259  & " is invalid for a linear elasticity equation."
2260  CALL flagerror(local_error,err,error,*999)
2261  END SELECT
2262  CASE DEFAULT
2263  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2264  & " is invalid for a linear elasticity equation."
2265  CALL flagerror(local_error,err,error,*999)
2266  END SELECT
2267 
2268  !
2269  ! ONE DIMENSIONAL ELASTICITY
2270  !
2271  CASE(equations_set_one_dimensional_subtype)
2272  SELECT CASE(equations_set_setup%SETUP_TYPE)
2273  CASE(equations_set_setup_initial_type)
2274  SELECT CASE(equations_set_setup%ACTION_TYPE)
2275  CASE(equations_set_setup_start_action)
2276  !Default to FEM solution
2277  CALL linearelasticity_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
2278  & err,error,*999)
2279  CASE(equations_set_setup_finish_action)
2280 !!TODO: Check valid setup
2281  CASE DEFAULT
2282  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2283  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2284  & " is invalid for a linear elasticity equation."
2285  CALL flagerror(local_error,err,error,*999)
2286  END SELECT
2287  CASE(equations_set_setup_geometry_type)
2288  !Do nothing???
2289  CASE(equations_set_setup_dependent_type)
2290  SELECT CASE(equations_set_setup%ACTION_TYPE)
2291  CASE(equations_set_setup_start_action)
2292  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2293  !Create the auto created dependent field
2294  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
2295  & dependent_field,err,error,*999)
2296  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
2297  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
2298  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2299  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
2300  & err,error,*999)
2301  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
2302  & geometric_field,err,error,*999)
2303  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
2304  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
2305  & field_deludeln_variable_type/),err,error,*999)
2306  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2307  & field_vector_dimension_type,err,error,*999)
2308  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2309  & field_vector_dimension_type,err,error,*999)
2310  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2311  & field_dp_type,err,error,*999)
2312  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2313  & field_dp_type,err,error,*999)
2314  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2315  & number_of_dimensions,err,error,*999)
2316  number_of_components=number_of_dimensions
2317  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2318  & number_of_components,err,error,*999)
2319  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2320  & number_of_components,err,error,*999)
2321  !Default to the geometric interpolation setup
2322  DO component_idx=1,number_of_dimensions
2323  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2324  & component_idx,geometric_mesh_component,err,error,*999)
2325  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2326  & component_idx,geometric_mesh_component,err,error,*999)
2327  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2328  & component_idx,geometric_mesh_component,err,error,*999)
2329  ENDDO !component_idx
2330  SELECT CASE(equations_set%SOLUTION_METHOD)
2331  CASE(equations_set_fem_solution_method)
2332  DO component_idx=1,number_of_components
2333  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2334  & component_idx,field_node_based_interpolation,err,error,*999)
2335  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2336  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
2337  ENDDO !component_idx
2338  !Default the scaling to the geometric field scaling
2339  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2340  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
2341  CASE(equations_set_bem_solution_method)
2342  CALL flagerror("Not implemented.",err,error,*999)
2343  CASE(equations_set_fd_solution_method)
2344  CALL flagerror("Not implemented.",err,error,*999)
2345  CASE(equations_set_fv_solution_method)
2346  CALL flagerror("Not implemented.",err,error,*999)
2347  CASE(equations_set_gfem_solution_method)
2348  CALL flagerror("Not implemented.",err,error,*999)
2349  CASE(equations_set_gfv_solution_method)
2350  CALL flagerror("Not implemented.",err,error,*999)
2351  CASE DEFAULT
2352  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2353  & " is invalid."
2354  CALL flagerror(local_error,err,error,*999)
2355  END SELECT
2356  ELSE
2357  !Check the user specified field
2358  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2359  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2360  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2361  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
2362  & err,error,*999)
2363  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2364  & err,error,*999)
2365  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
2366  & err,error,*999)
2367  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2368  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2369  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2370  & number_of_dimensions,err,error,*999)
2371  number_of_components=number_of_dimensions
2372  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_components, &
2373  & err,error,*999)
2374  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,number_of_components, &
2375  & err,error,*999)
2376  SELECT CASE(equations_set%SOLUTION_METHOD)
2377  CASE(equations_set_fem_solution_method)
2378  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2379  & field_node_based_interpolation,err,error,*999)
2380  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2381  & field_node_based_interpolation,err,error,*999)
2382  CASE(equations_set_bem_solution_method)
2383  CALL flagerror("Not implemented.",err,error,*999)
2384  CASE(equations_set_fd_solution_method)
2385  CALL flagerror("Not implemented.",err,error,*999)
2386  CASE(equations_set_fv_solution_method)
2387  CALL flagerror("Not implemented.",err,error,*999)
2388  CASE(equations_set_gfem_solution_method)
2389  CALL flagerror("Not implemented.",err,error,*999)
2390  CASE(equations_set_gfv_solution_method)
2391  CALL flagerror("Not implemented.",err,error,*999)
2392  CASE DEFAULT
2393  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2394  & " is invalid."
2395  CALL flagerror(local_error,err,error,*999)
2396  END SELECT
2397  ENDIF
2398  CASE(equations_set_setup_finish_action)
2399  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2400  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2401  ENDIF
2402  CASE DEFAULT
2403  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2404  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2405  & " is invalid for a linear elasticity equation"
2406  CALL flagerror(local_error,err,error,*999)
2407  END SELECT
2408  CASE(equations_set_setup_materials_type)
2409  SELECT CASE(equations_set_setup%ACTION_TYPE)
2410  CASE(equations_set_setup_start_action)
2411  equations_materials=>equations_set%MATERIALS
2412  IF(ASSOCIATED(equations_materials)) THEN
2413  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2414  !Default to the general 3D orthotropic material
2415  !Create the auto created materials field
2416  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
2417  & materials_field,err,error,*999)
2418  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2419  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
2420  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2421  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
2422  & err,error,*999)
2423  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2424  & geometric_field,err,error,*999)
2425  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
2426  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
2427  & err,error,*999)
2428  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2429  & field_vector_dimension_type,err,error,*999)
2430  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2431  & field_dp_type,err,error,*999)
2432  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2433  & 6,err,error,*999)
2434  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2435  & 1,geometric_component_number,err,error,*999)
2436  DO component_idx=1,6
2437  !Default to to the first geometric component with constant interpolation
2438  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2439  & component_idx,geometric_component_number,err,error,*999)
2440  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2441  & component_idx,field_constant_interpolation,err,error,*999)
2442  ENDDO !component_idx
2443  !Default the field scaling to that of the geometric field
2444  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2445  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2446  ELSE
2447  !Check the user specified field
2448  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2449  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2450  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2451  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2452  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2453  & err,error,*999)
2454  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2455  !2 Components for 2D Isotropic Linear Elasticity
2456  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,2,err,error,*999)
2457  ENDIF
2458  ELSE
2459  CALL flagerror("Equations materials is not associated.",err,error,*999)
2460  ENDIF
2461  CASE(equations_set_setup_finish_action)
2462  equations_materials=>equations_set%MATERIALS
2463  IF(ASSOCIATED(equations_materials)) THEN
2464  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2465  !Finish creating the materials field
2466  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2467  !Set the default values for the materials field
2468  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2469  & field_values_set_type,1,30.0e6_dp,err,error,*999) !Young's Modulus
2470  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2471  & field_values_set_type,2,0.25_dp,err,error,*999) !Poisson's Ratio
2472  ENDIF
2473  ELSE
2474  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2475  ENDIF
2476  CASE DEFAULT
2477  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2478  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2479  & " is invalid for a linear elasticity equation."
2480  CALL flagerror(local_error,err,error,*999)
2481  END SELECT
2482  CASE(equations_set_setup_source_type)
2483  SELECT CASE(equations_set_setup%ACTION_TYPE)
2484  CASE(equations_set_setup_start_action)
2485  !Do nothing
2486  CASE(equations_set_setup_finish_action)
2487  !Do nothing
2488  !? Maybe set finished flag????
2489  CASE DEFAULT
2490  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2491  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2492  & " is invalid for a linear elasticity equation."
2493  CALL flagerror(local_error,err,error,*999)
2494  END SELECT
2495 
2496  CASE(equations_set_setup_analytic_type)
2497  SELECT CASE(equations_set_setup%ACTION_TYPE)
2498  CASE(equations_set_setup_start_action)
2499  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2500  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2501  IF(ASSOCIATED(dependent_field)) THEN
2502  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
2503  IF(ASSOCIATED(geometric_field)) THEN
2504  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
2505  !List 3 Dimensional Analytic function types currently implemented
2506  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
2507  CASE(equations_set_linear_elasticity_one_dim_1)
2508  !Check that we are in 1D
2509  IF(number_of_dimensions/=1) THEN
2510  local_error="The number of geometric dimensions of "// &
2511  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2512  & " is invalid. The analytic function type of "// &
2513  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2514  & " requires that there be 1 geometric dimension."
2515  CALL flagerror(local_error,err,error,*999)
2516  ENDIF
2517  !Create analytic field if required
2518  !Set analtyic function type
2519  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_linear_elasticity_one_dim_1
2520  CASE DEFAULT
2521  local_error="The specified analytic function type of "// &
2522  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2523  & " is invalid for a standard Linear Elasticity equation."
2524  CALL flagerror(local_error,err,error,*999)
2525  END SELECT
2526  ELSE
2527  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
2528  ENDIF
2529  ELSE
2530  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
2531  ENDIF
2532  ELSE
2533  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2534  ENDIF
2535  CASE(equations_set_setup_finish_action)
2536  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
2537  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
2538  IF(ASSOCIATED(analytic_field)) THEN
2539  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
2540  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2541  ENDIF
2542  ENDIF
2543  ELSE
2544  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
2545  ENDIF
2546  CASE DEFAULT
2547  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2548  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2549  & " is invalid for a standard Linear Elasticity equation."
2550  CALL flagerror(local_error,err,error,*999)
2551  END SELECT
2552 
2553  CASE(equations_set_setup_equations_type)
2554  SELECT CASE(equations_set_setup%ACTION_TYPE)
2555  CASE(equations_set_setup_start_action)
2556  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2557  !Create the equations
2558  CALL equations_create_start(equations_set,equations,err,error,*999)
2559  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
2560  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2561  ELSE
2562  CALL flagerror("Equations set dependent field has not bee finished.",err,error,*999)
2563  ENDIF
2564  CASE(equations_set_setup_finish_action)
2565  SELECT CASE(equations_set%SOLUTION_METHOD)
2566  CASE(equations_set_fem_solution_method)
2567  !Finish the equations creation
2568  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2569  CALL equations_create_finish(equations,err,error,*999)
2570  !Create the equations mapping.
2571  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2572  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2573  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
2574  & err,error,*999)
2575  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2576  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2577  !Create the equations matrices
2578  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2579  SELECT CASE(equations%SPARSITY_TYPE)
2580  CASE(equations_matrices_full_matrices)
2581  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
2582  & err,error,*999)
2583  CASE(equations_matrices_sparse_matrices)
2584  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
2585  & err,error,*999)
2586  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
2587  & err,error,*999)
2588  CASE DEFAULT
2589  local_error="The equations matrices sparsity type of "// &
2590  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2591  CALL flagerror(local_error,err,error,*999)
2592  END SELECT
2593  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2594  CASE(equations_set_bem_solution_method)
2595  CALL flagerror("Not implemented.",err,error,*999)
2596  CASE(equations_set_fd_solution_method)
2597  CALL flagerror("Not implemented.",err,error,*999)
2598  CASE(equations_set_fv_solution_method)
2599  CALL flagerror("Not implemented.",err,error,*999)
2600  CASE(equations_set_gfem_solution_method)
2601  CALL flagerror("Not implemented.",err,error,*999)
2602  CASE(equations_set_gfv_solution_method)
2603  CALL flagerror("Not implemented.",err,error,*999)
2604  CASE DEFAULT
2605  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2606  & " is invalid."
2607  CALL flagerror(local_error,err,error,*999)
2608  END SELECT
2609  CASE DEFAULT
2610  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2611  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2612  & " is invalid for a linear elasticity equation."
2613  CALL flagerror(local_error,err,error,*999)
2614  END SELECT
2615  CASE DEFAULT
2616  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2617  & " is invalid for a linear elasticity equation."
2618  CALL flagerror(local_error,err,error,*999)
2619  END SELECT
2620  CASE(equations_set_plate_subtype)
2621  CALL flagerror("Not implemented.",err,error,*999)
2622  CASE(equations_set_shell_subtype)
2623  CALL flagerror("Not implemented.",err,error,*999)
2624  CASE DEFAULT
2625  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2626  & " is not valid for a linear elasticity equation type of an elasticity equation set class."
2627  CALL flagerror(local_error,err,error,*999)
2628  END SELECT
2629  ELSE
2630  CALL flagerror("Equations set is not associated.",err,error,*999)
2631  ENDIF
2632 
2633  exits("LINEAR_ELASTICITY_EQUATIONS_SET_SETUP")
2634  RETURN
2635 999 errorsexits("LINEAR_ELASTICITY_EQUATIONS_SET_SETUP",err,error)
2636  RETURN 1
2637  END SUBROUTINE linear_elasticity_equations_set_setup
2638 
2639  !
2640  !================================================================================================================================
2641  !
2642 
2644  SUBROUTINE linearelasticity_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
2645 
2646  !Argument variables
2647  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2648  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
2649  INTEGER(INTG), INTENT(OUT) :: ERR
2650  TYPE(varying_string), INTENT(OUT) :: ERROR
2651  !Local Variables
2652  TYPE(varying_string) :: LOCAL_ERROR
2653 
2654  enters("LinearElasticity_EquationsSetSolutionMethodSet",err,error,*999)
2655 
2656  IF(ASSOCIATED(equations_set)) THEN
2657  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2658  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2659  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2660  CALL flagerror("Equations set specification must have three entries for a linear elasticity type equations set.", &
2661  & err,error,*999)
2662  END IF
2663  SELECT CASE(equations_set%SPECIFICATION(3))
2664  CASE(equations_set_three_dimensional_subtype)
2665  SELECT CASE(solution_method)
2666  CASE(equations_set_fem_solution_method)
2667  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2668  CASE(equations_set_bem_solution_method)
2669  CALL flagerror("Not implemented.",err,error,*999)
2670  CASE(equations_set_fd_solution_method)
2671  CALL flagerror("Not implemented.",err,error,*999)
2672  CASE(equations_set_fv_solution_method)
2673  CALL flagerror("Not implemented.",err,error,*999)
2674  CASE(equations_set_gfem_solution_method)
2675  CALL flagerror("Not implemented.",err,error,*999)
2676  CASE(equations_set_gfv_solution_method)
2677  CALL flagerror("Not implemented.",err,error,*999)
2678  CASE DEFAULT
2679  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2680  CALL flagerror(local_error,err,error,*999)
2681  END SELECT
2682  CASE(equations_set_two_dimensional_plane_stress_subtype)
2683  SELECT CASE(solution_method)
2684  CASE(equations_set_fem_solution_method)
2685  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2686  CASE(equations_set_bem_solution_method)
2687  CALL flagerror("Not implemented.",err,error,*999)
2688  CASE(equations_set_fd_solution_method)
2689  CALL flagerror("Not implemented.",err,error,*999)
2690  CASE(equations_set_fv_solution_method)
2691  CALL flagerror("Not implemented.",err,error,*999)
2692  CASE(equations_set_gfem_solution_method)
2693  CALL flagerror("Not implemented.",err,error,*999)
2694  CASE(equations_set_gfv_solution_method)
2695  CALL flagerror("Not implemented.",err,error,*999)
2696  CASE DEFAULT
2697  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2698  CALL flagerror(local_error,err,error,*999)
2699  END SELECT
2700  CASE(equations_set_two_dimensional_plane_strain_subtype)
2701  SELECT CASE(solution_method)
2702  CASE(equations_set_fem_solution_method)
2703  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2704  CASE(equations_set_bem_solution_method)
2705  CALL flagerror("Not implemented.",err,error,*999)
2706  CASE(equations_set_fd_solution_method)
2707  CALL flagerror("Not implemented.",err,error,*999)
2708  CASE(equations_set_fv_solution_method)
2709  CALL flagerror("Not implemented.",err,error,*999)
2710  CASE(equations_set_gfem_solution_method)
2711  CALL flagerror("Not implemented.",err,error,*999)
2712  CASE(equations_set_gfv_solution_method)
2713  CALL flagerror("Not implemented.",err,error,*999)
2714  CASE DEFAULT
2715  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2716  CALL flagerror(local_error,err,error,*999)
2717  END SELECT
2718  CASE(equations_set_one_dimensional_subtype)
2719  SELECT CASE(solution_method)
2720  CASE(equations_set_fem_solution_method)
2721  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2722  CASE(equations_set_bem_solution_method)
2723  CALL flagerror("Not implemented.",err,error,*999)
2724  CASE(equations_set_fd_solution_method)
2725  CALL flagerror("Not implemented.",err,error,*999)
2726  CASE(equations_set_fv_solution_method)
2727  CALL flagerror("Not implemented.",err,error,*999)
2728  CASE(equations_set_gfem_solution_method)
2729  CALL flagerror("Not implemented.",err,error,*999)
2730  CASE(equations_set_gfv_solution_method)
2731  CALL flagerror("Not implemented.",err,error,*999)
2732  CASE DEFAULT
2733  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2734  CALL flagerror(local_error,err,error,*999)
2735  END SELECT
2736  CASE(equations_set_plate_subtype)
2737  CALL flagerror("Not implemented.",err,error,*999)
2738  CASE(equations_set_shell_subtype)
2739  CALL flagerror("Not implemented.",err,error,*999)
2740  CASE DEFAULT
2741  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2742  & " is not valid for a linear elasticity equation type of an elasticity equations set class."
2743  CALL flagerror(local_error,err,error,*999)
2744  END SELECT
2745  ELSE
2746  CALL flagerror("Equations set is not associated.",err,error,*999)
2747  ENDIF
2748 
2749  exits("LinearElasticity_EquationsSetSolutionMethodSet")
2750  RETURN
2751 999 errors("LinearElasticity_EquationsSetSolutionMethodSet",err,error)
2752  exits("LinearElasticity_EquationsSetSolutionMethodSet")
2753  RETURN 1
2754 
2755  END SUBROUTINE linearelasticity_equationssetsolutionmethodset
2756 
2757  !
2758  !================================================================================================================================
2759  !
2760 
2762  SUBROUTINE linearelasticity_equationssetspecificationset(equationsSet,specification,err,error,*)
2763 
2764  !Argument variables
2765  TYPE(equations_set_type), POINTER :: equationsSet
2766  INTEGER(INTG), INTENT(IN) :: specification(:)
2767  INTEGER(INTG), INTENT(OUT) :: err
2768  TYPE(varying_string), INTENT(OUT) :: error
2769  !Local Variables
2770  TYPE(varying_string) :: localError
2771 
2772  enters("LinearElasticity_EquationsSetSpecificationSet",err,error,*999)
2773 
2774  IF(ASSOCIATED(equationsset)) THEN
2775  IF(SIZE(specification,1)/=3) THEN
2776  CALL flagerror("Equations set specification must have three entries for a linear elasticity type equations set.", &
2777  & err,error,*999)
2778  END IF
2779  SELECT CASE(specification(3))
2780  CASE(equations_set_three_dimensional_subtype, &
2781  & equations_set_two_dimensional_plane_stress_subtype, &
2782  & equations_set_two_dimensional_plane_strain_subtype, &
2783  & equations_set_one_dimensional_subtype)
2784  !ok
2785  CASE(equations_set_plate_subtype)
2786  CALL flagerror("Not implemented.",err,error,*999)
2787  CASE(equations_set_shell_subtype)
2788  CALL flagerror("Not implemented.",err,error,*999)
2789  CASE DEFAULT
2790  localerror="The third equations set specification of "//trim(numbertovstring(specification(3),"*",err,error))// &
2791  & " is not valid for a linear elasticity equations set."
2792  CALL flagerror(localerror,err,error,*999)
2793  END SELECT
2794  !Set full specification
2795  IF(ALLOCATED(equationsset%specification)) THEN
2796  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
2797  ELSE
2798  ALLOCATE(equationsset%specification(3),stat=err)
2799  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
2800  END IF
2801  equationsset%specification(1:3)=[equations_set_elasticity_class,equations_set_linear_elasticity_type,specification(3)]
2802  ELSE
2803  CALL flagerror("Equations set is not associated.",err,error,*999)
2804  END IF
2805 
2806  exits("LinearElasticity_EquationsSetSpecificationSet")
2807  RETURN
2808 999 errors("LinearElasticity_EquationsSetSpecificationSet",err,error)
2809  exits("LinearElasticity_EquationsSetSpecificationSet")
2810  RETURN 1
2811 
2812  END SUBROUTINE linearelasticity_equationssetspecificationset
2813 
2814  !
2815  !================================================================================================================================
2816  !
2817 
2819  SUBROUTINE linear_elasticity_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
2820 
2821  !Argument variables
2822  TYPE(problem_type), POINTER :: PROBLEM
2823  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
2824  INTEGER(INTG), INTENT(OUT) :: ERR
2825  TYPE(varying_string), INTENT(OUT) :: ERROR
2826  !Local Variables
2827  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
2828  TYPE(solver_type), POINTER :: SOLVER
2829  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
2830  TYPE(solvers_type), POINTER :: SOLVERS
2831  TYPE(varying_string) :: LOCAL_ERROR
2832 
2833  enters("LINEAR_ELASTICITY_PROBLEM_SETUP",err,error,*999)
2834 
2835  NULLIFY(control_loop)
2836  NULLIFY(solver)
2837  NULLIFY(solver_equations)
2838  NULLIFY(solvers)
2839  IF(ASSOCIATED(problem)) THEN
2840  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2841  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2842  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
2843  CALL flagerror("Problem specification must have three entries for a linear elasticity problem.",err,error,*999)
2844  END IF
2845  SELECT CASE(problem%SPECIFICATION(3))
2846  CASE(problem_no_subtype)
2847  SELECT CASE(problem_setup%SETUP_TYPE)
2848  CASE(problem_setup_initial_type)
2849  SELECT CASE(problem_setup%ACTION_TYPE)
2850  CASE(problem_setup_start_action)
2851  !Do nothing????
2852  CASE(problem_setup_finish_action)
2853  !Do nothing????
2854  CASE DEFAULT
2855  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2856  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2857  & " is invalid for a linear elasticity problem."
2858  CALL flagerror(local_error,err,error,*999)
2859  END SELECT
2860  CASE(problem_setup_control_type)
2861  SELECT CASE(problem_setup%ACTION_TYPE)
2862  CASE(problem_setup_start_action)
2863  !Set up a simple control loop
2864  CALL control_loop_create_start(problem,control_loop,err,error,*999)
2865  CASE(problem_setup_finish_action)
2866  !Finish the control loops
2867  control_loop_root=>problem%CONTROL_LOOP
2868  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2869  CALL control_loop_create_finish(control_loop,err,error,*999)
2870  CASE DEFAULT
2871  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2872  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2873  & " is invalid for a linear elasticity problem."
2874  CALL flagerror(local_error,err,error,*999)
2875  END SELECT
2876  CASE(problem_setup_solvers_type)
2877  !Get the control loop
2878  control_loop_root=>problem%CONTROL_LOOP
2879  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2880  SELECT CASE(problem_setup%ACTION_TYPE)
2881  CASE(problem_setup_start_action)
2882  !Start the solvers creation
2883  CALL solvers_create_start(control_loop,solvers,err,error,*999)
2884  CALL solvers_number_set(solvers,1,err,error,*999)
2885  !Set the solver to be a linear solver
2886  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2887  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
2888  !Set solver defaults
2889  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
2890  CASE(problem_setup_finish_action)
2891  !Get the solvers
2892  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2893  !Finish the solvers creation
2894  CALL solvers_create_finish(solvers,err,error,*999)
2895  CASE DEFAULT
2896  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2897  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2898  & " is invalid for a linear elasticity problem."
2899  CALL flagerror(local_error,err,error,*999)
2900  END SELECT
2901  CASE(problem_setup_solver_equations_type)
2902  SELECT CASE(problem_setup%ACTION_TYPE)
2903  CASE(problem_setup_start_action)
2904  !Get the control loop
2905  control_loop_root=>problem%CONTROL_LOOP
2906  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2907  !Get the solver
2908  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2909  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2910  !Create the solver equations
2911  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
2912  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
2913  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
2914  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
2915  CASE(problem_setup_finish_action)
2916  !Get the control loop
2917  control_loop_root=>problem%CONTROL_LOOP
2918  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2919  !Get the solver equations
2920  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2921  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2922  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
2923  !Finish the solver equations creation
2924  CALL solver_equations_create_finish(solver_equations,err,error,*999)
2925  CASE DEFAULT
2926  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2927  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2928  & " is invalid for a linear elasticity problem."
2929  CALL flagerror(local_error,err,error,*999)
2930  END SELECT
2931  CASE DEFAULT
2932  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2933  & " is invalid for a linear elasticity problem."
2934  CALL flagerror(local_error,err,error,*999)
2935  END SELECT
2936  CASE DEFAULT
2937  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
2938  & " is not valid for a linear elasticity type of an elasticity problem class."
2939  CALL flagerror(local_error,err,error,*999)
2940  END SELECT
2941  ELSE
2942  CALL flagerror("Problem is not associated.",err,error,*999)
2943  ENDIF
2944 
2945  exits("LINEAR_ELASTICITY_PROBLEM_SETUP")
2946  RETURN
2947 999 errorsexits("LINEAR_ELASTICITY_PROBLEM_SETUP",err,error)
2948  RETURN 1
2949  END SUBROUTINE linear_elasticity_problem_setup
2950 
2951  !
2952  !================================================================================================================================
2953  !
2954 
2956  SUBROUTINE linearelasticity_problemspecificationset(problem,problemSpecification,err,error,*)
2957 
2958  !Argument variables
2959  TYPE(problem_type), POINTER :: problem
2960  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
2961  INTEGER(INTG), INTENT(OUT) :: err
2962  TYPE(varying_string), INTENT(OUT) :: error
2963  !Local Variables
2964  TYPE(varying_string) :: localError
2965  INTEGER(INTG) :: problemSubtype
2966 
2967  enters("LinearElasticity_ProblemSpecificationSet",err,error,*999)
2968 
2969  IF(ASSOCIATED(problem)) THEN
2970  IF(SIZE(problemspecification,1)==3) THEN
2971  problemsubtype=problemspecification(3)
2972  SELECT CASE(problemsubtype)
2973  CASE(problem_no_subtype)
2974  !ok
2975  CASE DEFAULT
2976  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
2977  & " is not valid for a linear elasticity problem."
2978  CALL flagerror(localerror,err,error,*999)
2979  END SELECT
2980  ELSE IF(SIZE(problemspecification,1)<3) THEN
2981  !Linear elasticity problem doesn't require a subtype, set it to no type
2982  problemsubtype=problem_no_subtype
2983  ELSE
2984  CALL flagerror("Linear elasticity problem specification may only have 3 entries.",err,error,*999)
2985  END IF
2986  !Set full specification
2987  IF(ALLOCATED(problem%specification)) THEN
2988  CALL flagerror("Problem specification is already allocated.",err,error,*999)
2989  ELSE
2990  ALLOCATE(problem%specification(3),stat=err)
2991  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
2992  END IF
2993  problem%specification(1:3)=[problem_elasticity_class, problem_linear_elasticity_type, problemsubtype]
2994  ELSE
2995  CALL flagerror("Problem is not associated.",err,error,*999)
2996  END IF
2997 
2998  exits("LinearElasticity_ProblemSpecificationSet")
2999  RETURN
3000 999 errors("LinearElasticity_ProblemSpecificationSet",err,error)
3001  exits("LinearElasticity_ProblemSpecificationSet")
3002  RETURN 1
3003 
3004  END SUBROUTINE linearelasticity_problemspecificationset
3005 
3006  !
3007  !================================================================================================================================
3008  !
3009 
3010 END MODULE linear_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
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
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::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
constants::global_deriv_s1_s2_s3
integer(intg), parameter global_deriv_s1_s2_s3
Cross derivative in the s1, s2 and s3 direction i.e., d^3u/ds1ds2ds3.
Definition: constants.f90:220
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
equations_set_constants::equations_set_shell_subtype
integer(intg), parameter equations_set_shell_subtype
Definition: equations_set_constants.f90:119
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
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
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
problem_constants::problem_no_subtype
integer(intg), parameter problem_no_subtype
Definition: problem_constants.f90:113
linear_elasticity_routines::linear_elasticity_finite_element_calculate
subroutine, public linear_elasticity_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a linear elasticity finite element equations se...
Definition: linear_elasticity_routines.f90:1104
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
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_linear_elasticity_three_dim_2
integer(intg), parameter equations_set_linear_elasticity_three_dim_2
Definition: equations_set_constants.f90:478
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_two_dimensional_plane_stress_subtype
integer(intg), parameter equations_set_two_dimensional_plane_stress_subtype
Definition: equations_set_constants.f90:115
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
equations_set_constants::equations_set_linear_elasticity_type
integer(intg), parameter equations_set_linear_elasticity_type
Definition: equations_set_constants.f90:68
linear_elasticity_routines::linearelasticity_problemspecificationset
subroutine, public linearelasticity_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a linear elasticity type problem.
Definition: linear_elasticity_routines.f90:2957
linear_elasticity_routines::linear_elasticity_equations_set_setup
subroutine, public linear_elasticity_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Linear elasticity equation type of an elasticity equations set class. ...
Definition: linear_elasticity_routines.f90:1509
equations_set_constants::equations_set_plate_subtype
integer(intg), parameter equations_set_plate_subtype
Definition: equations_set_constants.f90:118
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
linear_elasticity_routines::linearelasticity_equationssetspecificationset
subroutine, public linearelasticity_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a linear elasticity equation type of an elasticity equations set ...
Definition: linear_elasticity_routines.f90:2763
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
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
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
This module contains all mathematics support routines.
Definition: maths.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
constants::global_deriv_s2
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
constants::global_deriv_s2_s3
integer(intg), parameter global_deriv_s2_s3
Global Cross derivative in the s2 and s3 direction i.e., d^2u/ds2ds3.
Definition: constants.f90:219
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
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
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
constants
This module contains all program wide constants.
Definition: constants.f90:45
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
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
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
equations_set_constants::equations_set_one_dimensional_subtype
integer(intg), parameter equations_set_one_dimensional_subtype
Definition: equations_set_constants.f90:114
linear_elasticity_routines::linear_elasticity_tensor
subroutine linear_elasticity_tensor(EQUATIONS_SET_SUBTYPE, MATERIALS_INTERPOLATED_POINT, ELASTICITY_TENSOR, ERR, ERROR,)
Evaluates the linear elasticity tensor.
Definition: linear_elasticity_routines.f90:1402
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
types::problem_setup_type
Definition: types.f90:3215
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
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
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
equations_set_constants::equations_set_elasticity_class
integer(intg), parameter equations_set_elasticity_class
Definition: equations_set_constants.f90:54
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
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
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
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
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
types::equations_set_materials_type
Definition: types.f90:1881
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
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_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
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
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
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
constants::global_deriv_s1_s2
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
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
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
equations_set_constants::equations_set_two_dimensional_plane_strain_subtype
integer(intg), parameter equations_set_two_dimensional_plane_strain_subtype
Definition: equations_set_constants.f90:116
equations_set_constants::equations_set_linear_elasticity_two_dim_1
integer(intg), parameter equations_set_linear_elasticity_two_dim_1
Definition: equations_set_constants.f90:475
types::quadrature_scheme_ptr_type
A buffer type to allow for an array of pointers to a QUADRATURE_SCHEME_TYPE.
Definition: types.f90:156
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::field_interpolated_point_type
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
equations_set_constants::equations_set_three_dimensional_subtype
integer(intg), parameter equations_set_three_dimensional_subtype
Definition: equations_set_constants.f90:117
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
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
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
boundary_conditions_routines::boundary_conditions_set_local_dof
Sets a boundary condition on the specified local DOF.
Definition: boundary_condition_routines.f90:143
linear_elasticity_routines::linearelasticity_equationssetsolutionmethodset
subroutine, public linearelasticity_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a linear elasticity equation type of an elasticity equations set...
Definition: linear_elasticity_routines.f90:2645
linear_elasticity_routines::linearelasticity_boundaryconditionsanalyticcalculate
subroutine, public linearelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
Definition: linear_elasticity_routines.f90:106
equations_set_constants::equations_set_linear_elasticity_three_dim_1
integer(intg), parameter equations_set_linear_elasticity_three_dim_1
Definition: equations_set_constants.f90:477
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
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
constants::global_deriv_s3
integer(intg), parameter global_deriv_s3
First global derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:217
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
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
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
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
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
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
linear_elasticity_routines
This module handles all linear elasticity routines.
Definition: linear_elasticity_routines.f90:45
problem_constants::problem_linear_elasticity_type
integer(intg), parameter problem_linear_elasticity_type
Definition: problem_constants.f90:68
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_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
constants::global_deriv_s1_s3
integer(intg), parameter global_deriv_s1_s3
Global Cross derivative in the s1 and s3 direction i.e., d^2u/ds1ds3.
Definition: constants.f90:218
problem_constants::problem_elasticity_class
integer(intg), parameter problem_elasticity_class
Definition: problem_constants.f90:55
linear_elasticity_routines::linear_elasticity_problem_setup
subroutine, public linear_elasticity_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the linear elasticity problem.
Definition: linear_elasticity_routines.f90:2820
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
equations_set_constants::equations_set_linear_elasticity_one_dim_1
integer(intg), parameter equations_set_linear_elasticity_one_dim_1
Definition: equations_set_constants.f90:474
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
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45