OpenCMISS-Iron Internal API Documentation
linear_elasticity_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE basis_routines
50  USE constants
53  USE domain_mappings
58  USE field_routines
59  USE input_output
61  USE kinds
62  USE matrix_vector
64  USE strings
65  USE solver_routines
66  USE timer
67  USE types
68  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 
85 
87 
89 
91 
93 
95 
97 
98 CONTAINS
99 
100  !
101  !================================================================================================================================
102  !
103 
105  SUBROUTINE linearelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
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  !
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  !
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 
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 
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  !
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  !
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 
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
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
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
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
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
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
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  !
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
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
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
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
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
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 
1097 
1098  !
1099  !================================================================================================================================
1100  !
1101 
1103  SUBROUTINE linear_elasticity_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
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  !
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 
1375  CALL flagerror("Not implemented.",err,error,*999)
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
1395 
1396  !
1397  !================================================================================================================================
1398  !
1399 
1401  SUBROUTINE linear_elasticity_tensor(EQUATIONS_SET_SUBTYPE,MATERIALS_INTERPOLATED_POINT,ELASTICITY_TENSOR,ERR,ERROR,*)
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.
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
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
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
1483  !Plane Strain Isotropic Linear Elasticity Tensor
1484  e1 = materials_interpolated_point%values(2,1)
1485  c11 = e1
1486  elasticity_tensor(1,1)=c11
1488  CALL flagerror("Not implemented.",err,error,*999)
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,*)
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  !
1547  SELECT CASE(equations_set_setup%SETUP_TYPE)
1549  SELECT CASE(equations_set_setup%ACTION_TYPE)
1551  !Default to FEM solution
1553  & err,error,*999)
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
1563  !Do nothing???
1565  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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)
1617  CALL flagerror("Not implemented.",err,error,*999)
1619  CALL flagerror("Not implemented.",err,error,*999)
1621  CALL flagerror("Not implemented.",err,error,*999)
1623  CALL flagerror("Not implemented.",err,error,*999)
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)
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)
1658  CALL flagerror("Not implemented.",err,error,*999)
1660  CALL flagerror("Not implemented.",err,error,*999)
1662  CALL flagerror("Not implemented.",err,error,*999)
1664  CALL flagerror("Not implemented.",err,error,*999)
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
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
1684  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
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
1761  SELECT CASE(equations_set_setup%ACTION_TYPE)
1763  !Do nothing
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 
1775  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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
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
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 
1845  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
1856  SELECT CASE(equations_set%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)
1873  & err,error,*999)
1876  & err,error,*999)
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)
1886  CALL flagerror("Not implemented.",err,error,*999)
1888  CALL flagerror("Not implemented.",err,error,*999)
1890  CALL flagerror("Not implemented.",err,error,*999)
1892  CALL flagerror("Not implemented.",err,error,*999)
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  !
1916  SELECT CASE(equations_set_setup%SETUP_TYPE)
1918  SELECT CASE(equations_set_setup%ACTION_TYPE)
1920  !Default to FEM solution
1922  & err,error,*999)
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
1932  !Do nothing???
1934  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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)
1986  CALL flagerror("Not implemented.",err,error,*999)
1988  CALL flagerror("Not implemented.",err,error,*999)
1990  CALL flagerror("Not implemented.",err,error,*999)
1992  CALL flagerror("Not implemented.",err,error,*999)
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)
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)
2027  CALL flagerror("Not implemented.",err,error,*999)
2029  CALL flagerror("Not implemented.",err,error,*999)
2031  CALL flagerror("Not implemented.",err,error,*999)
2033  CALL flagerror("Not implemented.",err,error,*999)
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
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
2053  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
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
2128  SELECT CASE(equations_set_setup%ACTION_TYPE)
2130  !Do nothing
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 
2142  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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
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 
2201  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
2212  SELECT CASE(equations_set%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)
2229  & err,error,*999)
2232  & err,error,*999)
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)
2242  CALL flagerror("Not implemented.",err,error,*999)
2244  CALL flagerror("Not implemented.",err,error,*999)
2246  CALL flagerror("Not implemented.",err,error,*999)
2248  CALL flagerror("Not implemented.",err,error,*999)
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  !
2272  SELECT CASE(equations_set_setup%SETUP_TYPE)
2274  SELECT CASE(equations_set_setup%ACTION_TYPE)
2276  !Default to FEM solution
2278  & err,error,*999)
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
2288  !Do nothing???
2290  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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)
2342  CALL flagerror("Not implemented.",err,error,*999)
2344  CALL flagerror("Not implemented.",err,error,*999)
2346  CALL flagerror("Not implemented.",err,error,*999)
2348  CALL flagerror("Not implemented.",err,error,*999)
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)
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)
2383  CALL flagerror("Not implemented.",err,error,*999)
2385  CALL flagerror("Not implemented.",err,error,*999)
2387  CALL flagerror("Not implemented.",err,error,*999)
2389  CALL flagerror("Not implemented.",err,error,*999)
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
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
2409  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
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
2483  SELECT CASE(equations_set_setup%ACTION_TYPE)
2485  !Do nothing
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 
2497  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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
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 
2554  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
2565  SELECT CASE(equations_set%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)
2582  & err,error,*999)
2585  & err,error,*999)
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)
2595  CALL flagerror("Not implemented.",err,error,*999)
2597  CALL flagerror("Not implemented.",err,error,*999)
2599  CALL flagerror("Not implemented.",err,error,*999)
2601  CALL flagerror("Not implemented.",err,error,*999)
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
2621  CALL flagerror("Not implemented.",err,error,*999)
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
2638 
2639  !
2640  !================================================================================================================================
2641  !
2642 
2644  SUBROUTINE linearelasticity_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
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))
2665  SELECT CASE(solution_method)
2667  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2669  CALL flagerror("Not implemented.",err,error,*999)
2671  CALL flagerror("Not implemented.",err,error,*999)
2673  CALL flagerror("Not implemented.",err,error,*999)
2675  CALL flagerror("Not implemented.",err,error,*999)
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
2683  SELECT CASE(solution_method)
2685  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2687  CALL flagerror("Not implemented.",err,error,*999)
2689  CALL flagerror("Not implemented.",err,error,*999)
2691  CALL flagerror("Not implemented.",err,error,*999)
2693  CALL flagerror("Not implemented.",err,error,*999)
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
2701  SELECT CASE(solution_method)
2703  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2705  CALL flagerror("Not implemented.",err,error,*999)
2707  CALL flagerror("Not implemented.",err,error,*999)
2709  CALL flagerror("Not implemented.",err,error,*999)
2711  CALL flagerror("Not implemented.",err,error,*999)
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
2719  SELECT CASE(solution_method)
2721  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2723  CALL flagerror("Not implemented.",err,error,*999)
2725  CALL flagerror("Not implemented.",err,error,*999)
2727  CALL flagerror("Not implemented.",err,error,*999)
2729  CALL flagerror("Not implemented.",err,error,*999)
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
2737  CALL flagerror("Not implemented.",err,error,*999)
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 
2756 
2757  !
2758  !================================================================================================================================
2759  !
2760 
2762  SUBROUTINE linearelasticity_equationssetspecificationset(equationsSet,specification,err,error,*)
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))
2784  !ok
2786  CALL flagerror("Not implemented.",err,error,*999)
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 
2813 
2814  !
2815  !================================================================================================================================
2816  !
2817 
2819  SUBROUTINE linear_elasticity_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
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)
2849  SELECT CASE(problem_setup%ACTION_TYPE)
2851  !Do nothing????
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
2861  SELECT CASE(problem_setup%ACTION_TYPE)
2863  !Set up a simple control loop
2864  CALL control_loop_create_start(problem,control_loop,err,error,*999)
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
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)
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)
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
2902  SELECT CASE(problem_setup%ACTION_TYPE)
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)
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,*)
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 
3005 
3006  !
3007  !================================================================================================================================
3008  !
3009 
3010 END MODULE linear_elasticity_routines
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
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
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
integer(intg), parameter equations_set_shell_subtype
This module handles all problem wide constants.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
integer(intg), parameter problem_no_subtype
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...
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
integer(intg), parameter equations_set_linear_elasticity_three_dim_2
This module handles all equations matrix and rhs routines.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
integer(intg), parameter equations_set_two_dimensional_plane_stress_subtype
integer(intg), parameter equations_set_setup_source_type
Source setup.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter equations_set_linear_elasticity_type
subroutine, public linearelasticity_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a linear elasticity type problem.
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. ...
integer(intg), parameter equations_set_plate_subtype
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public linearelasticity_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a linear elasticity equation type of an elasticity equations set ...
integer(intg), parameter solver_equations_static
Solver equations are static.
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
This module contains all mathematics support routines.
Definition: maths.f90:45
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
integer(intg), parameter solver_equations_linear
Solver equations are linear.
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
Contains information on a control loop.
Definition: types.f90:3185
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
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
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
This module contains all program wide constants.
Definition: constants.f90:45
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Contains the interpolated point coordinate metrics. Old CMISS name GL,GU,RG.
Definition: types.f90:1112
integer(intg), parameter equations_set_one_dimensional_subtype
subroutine linear_elasticity_tensor(EQUATIONS_SET_SUBTYPE, MATERIALS_INTERPOLATED_POINT, ELASTICITY_TENSOR, ERR, ERROR,)
Evaluates the linear elasticity tensor.
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
integer(intg), parameter equations_set_setup_start_action
Start setup action.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
integer(intg), parameter equations_set_elasticity_class
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
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
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
A buffer type to allow for an array of pointers to a BASIS_TYPE.
Definition: types.f90:179
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter equations_linear
The equations are linear.
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
This module handles all distributed matrix vector routines.
integer(intg), parameter equations_set_two_dimensional_plane_strain_subtype
integer(intg), parameter equations_set_linear_elasticity_two_dim_1
A buffer type to allow for an array of pointers to a QUADRATURE_SCHEME_TYPE.
Definition: types.f90:156
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
integer(intg), parameter equations_set_three_dimensional_subtype
Contains information about an equations matrix.
Definition: types.f90:1429
This module contains all routines dealing with (non-distributed) matrix and vectors types...
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Sets a boundary condition on the specified local DOF.
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...
subroutine, public linearelasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
integer(intg), parameter equations_set_linear_elasticity_three_dim_1
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
integer(intg), parameter global_deriv_s3
First global derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:217
Contains the parameters required to interpolate a field variable within an element. Old CMISS name XE.
Definition: types.f90:1141
Contains information on the setup information for an equations set.
Definition: types.f90:1866
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
integer(intg), parameter problem_setup_start_action
Start setup action.
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
This module handles all control loop routines.
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
This module handles all linear elasticity routines.
integer(intg), parameter problem_linear_elasticity_type
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
integer(intg), parameter global_deriv_s1_s3
Global Cross derivative in the s1 and s3 direction i.e., d^2u/ds1ds3.
Definition: constants.f90:218
integer(intg), parameter problem_elasticity_class
subroutine, public linear_elasticity_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the linear elasticity problem.
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Flags an error condition.
integer(intg), parameter, public solver_linear_type
A linear solver.
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
This module contains all kind definitions.
Definition: kinds.f90:45
integer(intg), parameter equations_set_linear_elasticity_one_dim_1
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
This module handles all formating and input and output.