OpenCMISS-Iron Internal API Documentation
equations_set_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE equations_set_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE bioelectric_routines
50  USE boundary_conditions_routines
51  USE classical_field_routines
52  USE cmiss_mpi
53  USE comp_environment
54  USE constants
55  USE coordinate_routines
56  USE field_routines
57  USE fitting_routines
58  USE distributed_matrix_vector
59  USE domain_mappings
60  USE elasticity_routines
61  USE equations_routines
62  USE equations_set_constants
63  USE equations_matrices_routines
64  USE field_routines
65  USE fluid_mechanics_routines
66  USE input_output
67  USE iso_varying_string
68  USE kinds
69  USE lists
70  USE matrix_vector
71  USE monodomain_equations_routines
72 #ifndef NOMPIMOD
73  USE mpi
74 #endif
75  USE multi_physics_routines
76  USE node_routines
77  USE strings
78  USE timer
79  USE types
80 
81 #include "macros.h"
82 
83  IMPLICIT NONE
84 
85 #ifdef NOMPIMOD
86 #include "mpif.h"
87 #endif
88 
89  PRIVATE
90 
91  !Module parameters
92 
93  !Module types
94 
95  !Module variables
96 
97  !Interfaces
98 
99  PUBLIC equations_set_analytic_create_start,equations_set_analytic_create_finish
100 
101  PUBLIC equations_set_analytic_destroy
102 
103  PUBLIC equations_set_analytic_evaluate
104 
105  PUBLIC equations_set_analytic_time_get,equations_set_analytic_time_set
106 
107  PUBLIC equations_set_assemble
108 
109  PUBLIC equations_set_backsubstitute,equations_set_nonlinear_rhs_update
110 
111  PUBLIC equations_set_boundary_conditions_analytic
112 
113  PUBLIC equations_set_create_start,equations_set_create_finish
114 
115  PUBLIC equations_set_destroy
116 
117  PUBLIC equations_sets_finalise,equations_sets_initialise
118 
119  PUBLIC equations_set_equations_create_finish,equations_set_equations_create_start
120 
121  PUBLIC equations_set_equations_destroy
122 
123  PUBLIC equations_set_materials_create_start,equations_set_materials_create_finish
124 
125  PUBLIC equations_set_materials_destroy
126 
127  PUBLIC equations_set_dependent_create_start,equations_set_dependent_create_finish
128 
129  PUBLIC equations_set_dependent_destroy
130 
131  PUBLIC equationsset_derivedcreatestart,equationsset_derivedcreatefinish
132 
133  PUBLIC equationsset_deriveddestroy
134 
135  PUBLIC equations_set_independent_create_start,equations_set_independent_create_finish
136 
137  PUBLIC equations_set_independent_destroy
138 
139  PUBLIC equations_set_jacobian_evaluate,equations_set_residual_evaluate
140 
141  PUBLIC equations_set_solution_method_get,equations_set_solution_method_set
142 
143  PUBLIC equations_set_source_create_start,equations_set_source_create_finish
144 
145  PUBLIC equations_set_source_destroy
146 
147  PUBLIC equationsset_specificationget,equationsset_specificationsizeget
148 
149  PUBLIC equationsset_tensorinterpolatexi
150 
151  PUBLIC equationsset_derivedvariablecalculate,equationsset_derivedvariableset
152 
153  PUBLIC equations_set_user_number_find
154 
155  PUBLIC equations_set_load_increment_apply
156 
157  PUBLIC equations_set_analytic_user_param_set,equations_set_analytic_user_param_get
158 
159 CONTAINS
160 
161  !
162  !================================================================================================================================
163  !
164 
166  SUBROUTINE equations_set_analytic_create_finish(EQUATIONS_SET,ERR,ERROR,*)
167 
168  !Argument variables
169  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
170  INTEGER(INTG), INTENT(OUT) :: ERR
171  TYPE(varying_string), INTENT(OUT) :: ERROR
172  !Local Variables
173  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
174  TYPE(field_type), POINTER :: ANALYTIC_FIELD
175 
176  enters("EQUATIONS_SET_ANALYTIC_CREATE_FINISH",err,error,*999)
177 
178  IF(ASSOCIATED(equations_set)) THEN
179  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
180  IF(equations_set%ANALYTIC%ANALYTIC_FINISHED) THEN
181  CALL flagerror("Equations set analytic has already been finished.",err,error,*999)
182  ELSE
183  !Initialise the setup
184  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
185  equations_set_setup_info%SETUP_TYPE=equations_set_setup_analytic_type
186  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
187  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
188  IF(ASSOCIATED(analytic_field)) THEN
189  equations_set_setup_info%FIELD_USER_NUMBER=analytic_field%USER_NUMBER
190  equations_set_setup_info%FIELD=>analytic_field
191  ENDIF
192  !Finish the equations set specific analytic setup
193  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
194  !Finalise the setup
195  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
196  !Finish the analytic creation
197  equations_set%ANALYTIC%ANALYTIC_FINISHED=.true.
198  ENDIF
199  ELSE
200  CALL flagerror("The equations set analytic is not associated.",err,error,*999)
201  ENDIF
202  ELSE
203  CALL flagerror("Equations set is not associated.",err,error,*999)
204  ENDIF
205 
206  exits("EQUATIONS_SET_ANALYTIC_CREATE_FINISH")
207  RETURN
208 999 errorsexits("EQUATIONS_SET_ANALYTIC_CREATE_FINISH",err,error)
209  RETURN 1
210  END SUBROUTINE equations_set_analytic_create_finish
211 
212  !
213  !================================================================================================================================
214  !
215 
217  SUBROUTINE equations_set_analytic_create_start(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE,ANALYTIC_FIELD_USER_NUMBER,ANALYTIC_FIELD, &
218  & err,error,*)
219 
220  !Argument variables
221  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
222  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
223  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FIELD_USER_NUMBER
224  TYPE(field_type), POINTER :: ANALYTIC_FIELD
225  INTEGER(INTG), INTENT(OUT) :: ERR
226  TYPE(varying_string), INTENT(OUT) :: ERROR
227  !Local Variables
228  INTEGER(INTG) :: DUMMY_ERR
229  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
230  TYPE(field_type), POINTER :: FIELD,GEOMETRIC_FIELD
231  TYPE(region_type), POINTER :: REGION,ANALYTIC_FIELD_REGION
232  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
233 
234  enters("EQUATIONS_SET_ANALYTIC_CREATE_START",err,error,*998)
235 
236  IF(ASSOCIATED(equations_set)) THEN
237  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
238  CALL flagerror("The equations set analytic is already associated.",err,error,*998)
239  ELSE
240  region=>equations_set%REGION
241  IF(ASSOCIATED(region)) THEN
242  IF(ASSOCIATED(analytic_field)) THEN
243  !Check the analytic field has been finished
244  IF(analytic_field%FIELD_FINISHED) THEN
245  !Check the user numbers match
246  IF(analytic_field_user_number/=analytic_field%USER_NUMBER) THEN
247  local_error="The specified analytic field user number of "// &
248  & trim(number_to_vstring(analytic_field_user_number,"*",err,error))// &
249  & " does not match the user number of the specified analytic field of "// &
250  & trim(number_to_vstring(analytic_field%USER_NUMBER,"*",err,error))//"."
251  CALL flagerror(local_error,err,error,*999)
252  ENDIF
253  analytic_field_region=>analytic_field%REGION
254  IF(ASSOCIATED(analytic_field_region)) THEN
255  !Check the field is defined on the same region as the equations set
256  IF(analytic_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
257  local_error="Invalid region setup. The specified analytic field has been created on region number "// &
258  & trim(number_to_vstring(analytic_field_region%USER_NUMBER,"*",err,error))// &
259  & " and the specified equations set has been created on region number "// &
260  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
261  CALL flagerror(local_error,err,error,*999)
262  ENDIF
263  !Check the specified analytic field has the same decomposition as the geometric field
264  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
265  IF(ASSOCIATED(geometric_field)) THEN
266  IF(.NOT.ASSOCIATED(geometric_field%DECOMPOSITION,analytic_field%DECOMPOSITION)) THEN
267  CALL flagerror("The specified analytic field does not have the same decomposition as the geometric "// &
268  & "field for the specified equations set.",err,error,*999)
269  ENDIF
270  ELSE
271  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
272  ENDIF
273  ELSE
274  CALL flagerror("The specified analytic field region is not associated.",err,error,*999)
275  ENDIF
276  ELSE
277  CALL flagerror("The specified analytic field has not been finished.",err,error,*999)
278  ENDIF
279  ELSE
280  !Check the user number has not already been used for a field in this region.
281  NULLIFY(field)
282  CALL field_user_number_find(analytic_field_user_number,region,field,err,error,*999)
283  IF(ASSOCIATED(field)) THEN
284  local_error="The specified analytic field user number of "// &
285  & trim(number_to_vstring(analytic_field_user_number,"*",err,error))// &
286  & "has already been used to create a field on region number "// &
287  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
288  CALL flagerror(local_error,err,error,*999)
289  ENDIF
290  ENDIF
291  !Initialise the equations set analytic
292  CALL equations_set_analytic_initialise(equations_set,err,error,*999)
293  IF(.NOT.ASSOCIATED(analytic_field)) equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED=.true.
294  !Initialise the setup
295  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
296  equations_set_setup_info%SETUP_TYPE=equations_set_setup_analytic_type
297  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
298  equations_set_setup_info%FIELD_USER_NUMBER=analytic_field_user_number
299  equations_set_setup_info%FIELD=>analytic_field
300  equations_set_setup_info%ANALYTIC_FUNCTION_TYPE=analytic_function_type
301  !Start the equations set specific analytic setup
302  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
303  !Finalise the setup
304  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
305  !Set pointers
306  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
307  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
308  ELSE
309  equations_set%ANALYTIC%ANALYTIC_FIELD=>analytic_field
310  ENDIF
311  ELSE
312  CALL flagerror("Equations set region is not associated.",err,error,*999)
313  ENDIF
314  ENDIF
315  ELSE
316  CALL flagerror("Equations set is not associated.",err,error,*998)
317  ENDIF
318 
319  exits("EQUATIONS_SET_ANALYTIC_CREATE_START")
320  RETURN
321 999 CALL equations_set_analytic_finalise(equations_set%ANALYTIC,dummy_err,dummy_error,*998)
322 998 errorsexits("EQUATIONS_SET_ANALYTIC_CREATE_START",err,error)
323  RETURN 1
324  END SUBROUTINE equations_set_analytic_create_start
325 
326  !
327  !================================================================================================================================
328  !
329 
331  SUBROUTINE equations_set_analytic_destroy(EQUATIONS_SET,ERR,ERROR,*)
332 
333  !Argument variables
334  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
335  INTEGER(INTG), INTENT(OUT) :: ERR
336  TYPE(varying_string), INTENT(OUT) :: ERROR
337  !Local Variables
338 
339  enters("EQUATIONS_SET_ANALYTIC_DESTROY",err,error,*999)
340 
341  IF(ASSOCIATED(equations_set)) THEN
342  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
343  CALL equations_set_analytic_finalise(equations_set%ANALYTIC,err,error,*999)
344  ELSE
345  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
346  ENDIF
347  ELSE
348  CALL flagerror("Equations set is not associated.",err,error,*999)
349  ENDIF
350 
351  exits("EQUATIONS_SET_ANALYTIC_DESTROY")
352  RETURN
353 999 errorsexits("EQUATIONS_SET_ANALYTIC_DESTROY",err,error)
354  RETURN 1
355  END SUBROUTINE equations_set_analytic_destroy
356 
357  !
358  !================================================================================================================================
359  !
360 
362  SUBROUTINE equations_set_analytic_evaluate(EQUATIONS_SET,ERR,ERROR,*)
363 
364  !Argument variables
365  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
366  INTEGER(INTG), INTENT(OUT) :: ERR
367  TYPE(varying_string), INTENT(OUT) :: ERROR
368  !Local Variables
369  INTEGER(INTG) :: component_idx,derivative_idx,element_idx,Gauss_idx,GLOBAL_DERIV_INDEX,local_ny,node_idx, &
370  & NUMBER_OF_ANALYTIC_COMPONENTS,NUMBER_OF_DIMENSIONS,variable_idx, &
371  & variable_type,version_idx
372  REAL(DP) :: NORMAL(3),POSITION(3),TANGENTS(3,3),VALUE
373  REAL(DP) :: ANALYTIC_DUMMY_VALUES(1)=0.0_dp
374  REAL(DP) :: MATERIALS_DUMMY_VALUES(1)=0.0_dp
375  LOGICAL :: reverseNormal=.false.
376  TYPE(basis_type), POINTER :: BASIS
377  TYPE(domain_type), POINTER :: DOMAIN
378  TYPE(domain_elements_type), POINTER :: DOMAIN_ELEMENTS
379  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
380  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
381  TYPE(field_interpolation_parameters_ptr_type), POINTER :: ANALYTIC_INTERP_PARAMETERS(:),GEOMETRIC_INTERP_PARAMETERS(:), &
382  & MATERIALS_INTERP_PARAMETERS(:)
383  TYPE(field_interpolated_point_ptr_type), POINTER :: ANALYTIC_INTERP_POINT(:),GEOMETRIC_INTERP_POINT(:), &
384  & MATERIALS_INTERP_POINT(:)
385  TYPE(field_interpolated_point_metrics_ptr_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT_METRICS(:)
386  TYPE(field_physical_point_ptr_type), POINTER :: ANALYTIC_PHYSICAL_POINT(:),MATERIALS_PHYSICAL_POINT(:)
387  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
388  TYPE(varying_string) :: LOCAL_ERROR
389 
390  enters("EQUATIONS_SET_ANALYTIC_EVALUATE",err,error,*999)
391 
392  IF(ASSOCIATED(equations_set)) THEN
393  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
394  IF(equations_set%ANALYTIC%ANALYTIC_FINISHED) THEN
395  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
396  IF(ASSOCIATED(dependent_field)) THEN
397  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
398  IF(ASSOCIATED(geometric_field)) THEN
399  CALL field_numberofcomponentsget(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
400  CALL field_interpolationparametersinitialise(geometric_field,geometric_interp_parameters,err,error,*999)
401  CALL field_interpolatedpointsinitialise(geometric_interp_parameters,geometric_interp_point,err,error,*999)
402  CALL field_interpolatedpointsmetricsinitialise(geometric_interp_point,geometric_interpolated_point_metrics, &
403  & err,error,*999)
404  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
405  IF(ASSOCIATED(analytic_field)) THEN
406  CALL field_numberofcomponentsget(analytic_field,field_u_variable_type,number_of_analytic_components, &
407  & err,error,*999)
408  CALL field_interpolationparametersinitialise(analytic_field,analytic_interp_parameters,err,error,*999)
409  CALL field_interpolatedpointsinitialise(analytic_interp_parameters,analytic_interp_point,err,error,*999)
410  CALL field_physicalpointsinitialise(analytic_interp_point,geometric_interp_point,analytic_physical_point, &
411  & err,error,*999)
412  ENDIF
413  NULLIFY(materials_field)
414  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
415  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
416  CALL field_numberofcomponentsget(materials_field,field_u_variable_type,number_of_analytic_components, &
417  & err,error,*999)
418  CALL field_interpolationparametersinitialise(materials_field,materials_interp_parameters,err,error,*999)
419  CALL field_interpolatedpointsinitialise(materials_interp_parameters,materials_interp_point,err,error,*999)
420  CALL field_physicalpointsinitialise(materials_interp_point,geometric_interp_point,materials_physical_point, &
421  & err,error,*999)
422  ENDIF
423  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
424  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
425  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
426  IF(ASSOCIATED(field_variable)) THEN
427  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
428  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
429  IF(ASSOCIATED(domain)) THEN
430  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
431  SELECT CASE(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
432  CASE(field_constant_interpolation)
433  CALL flagerror("Cannot evaluate an analytic solution for a constant interpolation components.", &
434  & err,error,*999)
435  CASE(field_element_based_interpolation)
436  domain_elements=>domain%TOPOLOGY%ELEMENTS
437  IF(ASSOCIATED(domain_elements)) THEN
438  !Loop over the local elements excluding the ghosts
439  DO element_idx=1,domain_elements%NUMBER_OF_ELEMENTS
440  basis=>domain_elements%ELEMENTS(element_idx)%BASIS
441  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
442  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
443  IF(ASSOCIATED(analytic_field)) THEN
444  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
445  & analytic_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
446  ENDIF
447  IF(ASSOCIATED(materials_field)) THEN
448  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
449  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
450  ENDIF
451  CALL field_interpolate_xi(first_part_deriv,[0.5_dp,0.5_dp,0.5_dp], &
452  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
453  CALL field_interpolatedpointmetricscalculate(coordinate_jacobian_no_type, &
454  & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,err,error,*999)
455  CALL field_positionnormaltangentscalculateintptmetric( &
456  & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,reversenormal, &
457  & position,normal,tangents,err,error,*999)
458  IF(ASSOCIATED(analytic_field)) THEN
459  CALL field_interpolate_xi(no_part_deriv,[0.5_dp,0.5_dp,0.5_dp], &
460  & analytic_interp_point(field_u_variable_type)%PTR,err,error,*999)
461  ENDIF
462  IF(ASSOCIATED(materials_field)) THEN
463  CALL field_interpolate_xi(no_part_deriv,[0.5_dp,0.5_dp,0.5_dp], &
464  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
465  ENDIF
466 !! \todo Maybe do this with optional arguments?
467  IF(ASSOCIATED(analytic_field)) THEN
468  IF(ASSOCIATED(materials_field)) THEN
469  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
470  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
471  & variable_type,global_deriv_index,component_idx, &
472  & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
473  & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
474  & VALUE,err,error,*999)
475  ELSE
476  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
477  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
478  & variable_type,global_deriv_index,component_idx, &
479  & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
480  & materials_dummy_values,VALUE,err,error,*999)
481  ENDIF
482  ELSE
483  IF(ASSOCIATED(materials_field)) THEN
484  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
485  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
486  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
487  & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
488  & VALUE,err,error,*999)
489  ELSE
490  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
491  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
492  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
493  & materials_dummy_values,VALUE,err,error,*999)
494  ENDIF
495  ENDIF
496  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
497  & element_param2dof_map%ELEMENTS(element_idx)
498  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
499  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
500  ENDDO !element_idx
501  ELSE
502  CALL flagerror("Domain topology elements is not associated.",err,error,*999)
503  ENDIF
504  CASE(field_node_based_interpolation)
505  domain_nodes=>domain%TOPOLOGY%NODES
506  IF(ASSOCIATED(domain_nodes)) THEN
507  !Loop over the local nodes excluding the ghosts.
508  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
509  CALL field_positionnormaltangentscalculatenode(dependent_field,variable_type,component_idx, &
510  & node_idx,position,normal,tangents,err,error,*999)
511  IF(ASSOCIATED(analytic_field)) THEN
512  CALL field_interpolate_field_node(no_physical_deriv,field_values_set_type,analytic_field, &
513  & field_u_variable_type,component_idx,node_idx,analytic_physical_point( &
514  & field_u_variable_type)%PTR,err,error,*999)
515  ENDIF
516  IF(ASSOCIATED(materials_field)) THEN
517  CALL field_interpolate_field_node(no_physical_deriv,field_values_set_type,materials_field, &
518  & field_u_variable_type,component_idx,node_idx,materials_physical_point( &
519  & field_u_variable_type)%PTR,err,error,*999)
520  ENDIF
521  !Loop over the derivatives
522  DO derivative_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
523  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(derivative_idx)% &
524  & global_derivative_index
525 !! \todo Maybe do this with optional arguments?
526  IF(ASSOCIATED(analytic_field)) THEN
527  IF(ASSOCIATED(materials_field)) THEN
528  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
529  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
530  & variable_type,global_deriv_index,component_idx, &
531  & analytic_physical_point(field_u_variable_type)%PTR%VALUES, &
532  & materials_physical_point(field_u_variable_type)%PTR%VALUES,VALUE,err,error,*999)
533  ELSE
534  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
535  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
536  & variable_type,global_deriv_index,component_idx, &
537  & analytic_physical_point(field_u_variable_type)%PTR%VALUES, &
538  & materials_dummy_values,VALUE,err,error,*999)
539  ENDIF
540  ELSE
541  IF(ASSOCIATED(materials_field)) THEN
542  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
543  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
544  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
545  & materials_physical_point(field_u_variable_type)%PTR%VALUES,VALUE,err,error,*999)
546  ELSE
547  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
548  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
549  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
550  & materials_dummy_values,VALUE,err,error,*999)
551  ENDIF
552  ENDIF
553  !Loop over the versions
554  DO version_idx=1,domain_nodes%NODES(node_idx)%DERIVATIVES(derivative_idx)%numberOfVersions
555  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
556  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(derivative_idx)%VERSIONS(version_idx)
557  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
558  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
559  ENDDO !version_idx
560  ENDDO !deriv_idx
561  ENDDO !node_idx
562  ELSE
563  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
564  ENDIF
565  CASE(field_grid_point_based_interpolation)
566  CALL flagerror("Not implemented.",err,error,*999)
567  CASE(field_gauss_point_based_interpolation)
568  domain_elements=>domain%TOPOLOGY%ELEMENTS
569  IF(ASSOCIATED(domain_elements)) THEN
570  !Loop over the local elements excluding the ghosts
571  DO element_idx=1,domain_elements%NUMBER_OF_ELEMENTS
572  basis=>domain_elements%ELEMENTS(element_idx)%BASIS
573  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
574  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
575  IF(ASSOCIATED(analytic_field)) THEN
576  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
577  & analytic_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
578  ENDIF
579  IF(ASSOCIATED(materials_field)) THEN
580  CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
581  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
582  ENDIF
583  !Loop over the Gauss points in the element
584  DO gauss_idx=1,basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR% &
585  & number_of_gauss
586  CALL field_interpolategauss(first_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
587  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
588  CALL field_interpolatedpointmetricscalculate(coordinate_jacobian_no_type, &
589  & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,err,error,*999)
590  CALL field_positionnormaltangentscalculateintptmetric( &
591  & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,reversenormal, &
592  & position,normal,tangents,err,error,*999)
593  IF(ASSOCIATED(analytic_field)) THEN
594  CALL field_interpolategauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
595  & analytic_interp_point(field_u_variable_type)%PTR,err,error,*999)
596  ENDIF
597  IF(ASSOCIATED(materials_field)) THEN
598  CALL field_interpolategauss(no_part_deriv,basis_default_quadrature_scheme,gauss_idx, &
599  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
600  ENDIF
601 !! \todo Maybe do this with optional arguments?
602  IF(ASSOCIATED(analytic_field)) THEN
603  IF(ASSOCIATED(materials_field)) THEN
604  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
605  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
606  & variable_type,global_deriv_index,component_idx, &
607  & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
608  & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
609  & VALUE,err,error,*999)
610  ELSE
611  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
612  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
613  & variable_type,global_deriv_index,component_idx, &
614  & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
615  & materials_dummy_values,VALUE,err,error,*999)
616  ENDIF
617  ELSE
618  IF(ASSOCIATED(materials_field)) THEN
619  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
620  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
621  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
622  & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,no_part_deriv), &
623  & VALUE,err,error,*999)
624  ELSE
625  CALL equations_set_analytic_functions_evaluate(equations_set,equations_set%ANALYTIC% &
626  & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
627  & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
628  & materials_dummy_values,VALUE,err,error,*999)
629  ENDIF
630  ENDIF
631  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
632  & gauss_point_param2dof_map%GAUSS_POINTS(gauss_idx,element_idx)
633  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
634  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
635  ENDDO !Gauss_idx
636  ENDDO !element_idx
637  ELSE
638  CALL flagerror("Domain topology elements is not associated.",err,error,*999)
639  ENDIF
640  CASE DEFAULT
641  local_error="The interpolation type of "//trim(number_to_vstring(field_variable% &
642  & components(component_idx)%INTERPOLATION_TYPE,"*",err,error))// &
643  & " for component "//trim(number_to_vstring(component_idx,"*",err,error))//" of variable type "// &
644  & trim(number_to_vstring(variable_type,"*",err,error))//" is invalid."
645  CALL flagerror(local_error,err,error,*999)
646  END SELECT
647  ELSE
648  CALL flagerror("Domain topology is not associated.",err,error,*999)
649  ENDIF
650  ELSE
651  CALL flagerror("Domain is not associated.",err,error,*999)
652  ENDIF
653  ENDDO !component_idx
654  CALL field_parametersetupdatestart(dependent_field,variable_type, &
655  & field_analytic_values_set_type,err,error,*999)
656  CALL field_parametersetupdatefinish(dependent_field,variable_type, &
657  & field_analytic_values_set_type,err,error,*999)
658  ELSE
659  CALL flagerror("Field variable is not associated.",err,error,*999)
660  ENDIF
661  ENDDO !variable_idx
662  IF(ASSOCIATED(materials_field)) THEN
663  CALL field_physical_points_finalise(materials_physical_point,err,error,*999)
664  CALL field_interpolated_points_finalise(materials_interp_point,err,error,*999)
665  CALL field_interpolation_parameters_finalise(materials_interp_parameters,err,error,*999)
666  ENDIF
667  IF(ASSOCIATED(analytic_field)) THEN
668  CALL field_physical_points_finalise(analytic_physical_point,err,error,*999)
669  CALL field_interpolated_points_finalise(analytic_interp_point,err,error,*999)
670  CALL field_interpolation_parameters_finalise(analytic_interp_parameters,err,error,*999)
671  ENDIF
672  CALL field_interpolatedpointsmetricsfinalise(geometric_interpolated_point_metrics,err,error,*999)
673  CALL field_interpolated_points_finalise(geometric_interp_point,err,error,*999)
674  CALL field_interpolation_parameters_finalise(geometric_interp_parameters,err,error,*999)
675 
676  ELSE
677  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
678  ENDIF
679  ELSE
680  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
681  ENDIF
682  ELSE
683  CALL flagerror("Equations set analytic has not been finished.",err,error,*999)
684  ENDIF
685  ELSE
686  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
687  ENDIF
688  ELSE
689  CALL flagerror("Equations set is not associated.",err,error,*999)
690  ENDIF
691 
692  exits("EQUATIONS_SET_ANALYTIC_EVALUATE")
693  RETURN
694 999 errorsexits("EQUATIONS_SET_ANALYTIC_EVALUATE",err,error)
695  RETURN 1
696 
697  END SUBROUTINE equations_set_analytic_evaluate
698 
699  !
700  !================================================================================================================================
701  !
702 
704  SUBROUTINE equations_set_analytic_finalise(EQUATIONS_SET_ANALYTIC,ERR,ERROR,*)
705 
706  !Argument variables
707  TYPE(equations_set_analytic_type), POINTER :: EQUATIONS_SET_ANALYTIC
708  INTEGER(INTG), INTENT(OUT) :: ERR
709  TYPE(varying_string), INTENT(OUT) :: ERROR
710  !Local Variables
711 
712  enters("EQUATIONS_SET_ANALYTIC_FINALISE",err,error,*999)
713 
714  IF(ASSOCIATED(equations_set_analytic)) THEN
715  DEALLOCATE(equations_set_analytic)
716  ENDIF
717 
718  exits("EQUATIONS_SET_ANALYTIC_FINALISE")
719  RETURN
720 999 errorsexits("EQUATIONS_SET_ANALYTIC_FINALISE",err,error)
721  RETURN 1
722  END SUBROUTINE equations_set_analytic_finalise
723 
724  !
725  !================================================================================================================================
726  !
727 
729  SUBROUTINE equations_set_analytic_functions_evaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE,POSITION,TANGENTS,NORMAL,TIME, &
730  & variable_type,global_derivative,component_number,analytic_parameters,materials_parameters,VALUE,err,error,*)
731 
732  !Argument variables
733  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
734  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
735  REAL(DP), INTENT(IN) :: POSITION(:)
736  REAL(DP), INTENT(IN) :: TANGENTS(:,:)
737  REAL(DP), INTENT(IN) :: NORMAL(:)
738  REAL(DP), INTENT(IN) :: TIME
739  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
740  INTEGER(INTG), INTENT(IN) :: GLOBAL_DERIVATIVE
741  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
742  REAL(DP), INTENT(IN) :: ANALYTIC_PARAMETERS(:)
743  REAL(DP), INTENT(IN) :: MATERIALS_PARAMETERS(:)
744  REAL(DP), INTENT(OUT) :: VALUE
745  INTEGER(INTG), INTENT(OUT) :: ERR
746  TYPE(varying_string), INTENT(OUT) :: ERROR
747  !Local Variables
748  TYPE(varying_string) :: LOCAL_ERROR
749 
750  enters("EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE",err,error,*999)
751 
752  IF(ASSOCIATED(equations_set)) THEN
753  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
754  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
755  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
756  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
757  END IF
758  SELECT CASE(equations_set%SPECIFICATION(1))
759  CASE(equations_set_elasticity_class)
760  CALL flagerror("Not implemented.",err,error,*999)
761  CASE(equations_set_fluid_mechanics_class)
762  CALL flagerror("Not implemented.",err,error,*999)
763  CASE(equations_set_electromagnetics_class)
764  CALL flagerror("Not implemented.",err,error,*999)
765  CASE(equations_set_classical_field_class)
766  IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
767  CALL flagerror("Equations set specification must have at least two entries for a "// &
768  & "classical field equations set.",err,error,*999)
769  END IF
770  CALL classical_field_analytic_functions_evaluate(equations_set,equations_set%SPECIFICATION(2), &
771  & analytic_function_type,position,tangents,normal,time,variable_type,global_derivative, &
772  & component_number,analytic_parameters,materials_parameters,VALUE,err,error,*999)
773  CASE(equations_set_fitting_class)
774  CALL flagerror("Not implemented.",err,error,*999)
775  CASE(equations_set_bioelectrics_class)
776  CALL flagerror("Not implemented.",err,error,*999)
777  CASE(equations_set_modal_class)
778  CALL flagerror("Not implemented.",err,error,*999)
779  CASE(equations_set_multi_physics_class)
780  CALL flagerror("Not implemented.",err,error,*999)
781  CASE DEFAULT
782  local_error="The first equations set specification of "// &
783  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
784  CALL flag_error(local_error,err,error,*999)
785  END SELECT
786  ELSE
787  CALL flagerror("Equations set is not associated.",err,error,*999)
788  ENDIF
789 
790  exits("EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE")
791  RETURN
792 999 errorsexits("EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE",err,error)
793  RETURN 1
794 
795  END SUBROUTINE equations_set_analytic_functions_evaluate
796 
797  !
798  !================================================================================================================================
799  !
800 
802  SUBROUTINE equations_set_analytic_initialise(EQUATIONS_SET,ERR,ERROR,*)
803 
804  !Argument variables
805  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
806  INTEGER(INTG), INTENT(OUT) :: ERR
807  TYPE(varying_string), INTENT(OUT) :: ERROR
808  !Local Variables
809  INTEGER(INTG) :: DUMMY_ERR
810  TYPE(varying_string) :: DUMMY_ERROR
811 
812  enters("EQUATIONS_SET_ANALYTIC_INITIALISE",err,error,*998)
813 
814  IF(ASSOCIATED(equations_set)) THEN
815  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
816  CALL flagerror("Analytic is already associated for this equations set.",err,error,*998)
817  ELSE
818  ALLOCATE(equations_set%ANALYTIC,stat=err)
819  IF(err/=0) CALL flagerror("Could not allocate equations set analytic.",err,error,*999)
820  equations_set%ANALYTIC%EQUATIONS_SET=>equations_set
821  equations_set%ANALYTIC%ANALYTIC_FINISHED=.false.
822  equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED=.false.
823  NULLIFY(equations_set%ANALYTIC%ANALYTIC_FIELD)
824  equations_set%ANALYTIC%ANALYTIC_TIME=0.0_dp
825  ENDIF
826  ELSE
827  CALL flagerror("Equations set is not associated.",err,error,*998)
828  ENDIF
829 
830  exits("EQUATIONS_SET_ANALYTIC_INITIALISE")
831  RETURN
832 999 CALL equations_set_analytic_finalise(equations_set%ANALYTIC,dummy_err,dummy_error,*998)
833 998 errorsexits("EQUATIONS_SET_ANALYTIC_INITIALISE",err,error)
834  RETURN 1
835 
836  END SUBROUTINE equations_set_analytic_initialise
837 
838  !
839  !================================================================================================================================
840  !
841 
843  SUBROUTINE equations_set_analytic_time_get(EQUATIONS_SET,TIME,ERR,ERROR,*)
844 
845  !Argument variables
846  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
847  REAL(DP), INTENT(OUT) :: TIME
848  INTEGER(INTG), INTENT(OUT) :: ERR
849  TYPE(varying_string), INTENT(OUT) :: ERROR
850  !Local Variables
851 
852  enters("EQUATIONS_SET_ANALYTIC_TIME_GET",err,error,*999)
853 
854  IF(ASSOCIATED(equations_set)) THEN
855  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
856  time=equations_set%ANALYTIC%ANALYTIC_TIME
857  ELSE
858  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
859  ENDIF
860  ELSE
861  CALL flagerror("Equations set is not associated.",err,error,*999)
862  ENDIF
863 
864  exits("EQUATIONS_SET_ANALYTIC_TIME_GET")
865  RETURN
866 999 errorsexits("EQUATIONS_SET_ANALYTIC_TIME_GET",err,error)
867  RETURN 1
868 
869  END SUBROUTINE equations_set_analytic_time_get
870 
871  !
872  !================================================================================================================================
873  !
874 
876  SUBROUTINE equations_set_analytic_time_set(EQUATIONS_SET,TIME,ERR,ERROR,*)
877 
878  !Argument variables
879  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
880  REAL(DP), INTENT(IN) :: TIME
881  INTEGER(INTG), INTENT(OUT) :: ERR
882  TYPE(varying_string), INTENT(OUT) :: ERROR
883  !Local Variables
884 
885  enters("EQUATIONS_SET_ANALYTIC_TIME_SET",err,error,*999)
886 
887  IF(ASSOCIATED(equations_set)) THEN
888  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
889  equations_set%ANALYTIC%ANALYTIC_TIME=time
890  ELSE
891  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
892  ENDIF
893  ELSE
894  CALL flagerror("Equations set is not associated.",err,error,*999)
895  ENDIF
896 
897  exits("EQUATIONS_SET_ANALYTIC_TIME_SET")
898  RETURN
899 999 errorsexits("EQUATIONS_SET_ANALYTIC_TIME_SET",err,error)
900  RETURN 1
901 
902  END SUBROUTINE equations_set_analytic_time_set
903 
904  !
905  !================================================================================================================================
906  !
907 
909  SUBROUTINE equations_set_analytic_user_param_set(EQUATIONS_SET,PARAM_IDX,PARAM,ERR,ERROR,*)
910  !Argument variables
911  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
912  INTEGER(INTG), INTENT(IN) :: PARAM_IDX
913  REAL(DP), INTENT(IN) :: PARAM
914  INTEGER(INTG), INTENT(OUT) :: ERR
915  TYPE(varying_string), INTENT(OUT) :: ERROR
916  !Local variables
917  TYPE(equations_set_analytic_type), POINTER :: ANALYTIC
918 
919  enters("EQUATIONS_SET_ANALYTIC_USER_PARAM_SET",err,error,*999)
920 
921  IF(ASSOCIATED(equations_set)) THEN
922  analytic=>equations_set%ANALYTIC
923  IF(ASSOCIATED(analytic)) THEN
924  IF(param_idx>0.AND.param_idx<=SIZE(analytic%ANALYTIC_USER_PARAMS)) THEN
925  !Set the value
926  analytic%ANALYTIC_USER_PARAMS(param_idx)=param
927  ELSE
928  CALL flagerror("Invalid parameter index.",err,error,*999)
929  ENDIF
930  ELSE
931  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
932  ENDIF
933  ELSE
934  CALL flagerror("Equations set is not associated.",err,error,*999)
935  ENDIF
936 
937  exits("EQUATIONS_SET_ANALYTIC_USER_PARAM_SET")
938  RETURN
939 999 errorsexits("EQUATIONS_SET_ANALYTIC_USER_PARAM_SET",err,error)
940  RETURN 1
941  END SUBROUTINE equations_set_analytic_user_param_set
942 
943  !
944  !================================================================================================================================
945  !
946 
948  SUBROUTINE equations_set_analytic_user_param_get(EQUATIONS_SET,PARAM_IDX,PARAM,ERR,ERROR,*)
949  !Argument variables
950  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
951  INTEGER(INTG), INTENT(IN) :: PARAM_IDX
952  REAL(DP), INTENT(OUT) :: PARAM
953  INTEGER(INTG), INTENT(OUT) :: ERR
954  TYPE(varying_string), INTENT(OUT) :: ERROR
955  !Local variables
956  TYPE(equations_set_analytic_type), POINTER :: ANALYTIC
957 
958  enters("EQUATIONS_SET_ANALYTIC_USER_PARAM_GET",err,error,*999)
959 
960  IF(ASSOCIATED(equations_set)) THEN
961  analytic=>equations_set%ANALYTIC
962  IF(ASSOCIATED(analytic)) THEN
963  IF(param_idx>0.AND.param_idx<=SIZE(analytic%ANALYTIC_USER_PARAMS)) THEN
964  !Set the value
965  param=analytic%ANALYTIC_USER_PARAMS(param_idx)
966  ELSE
967  CALL flagerror("Invalid parameter index.",err,error,*999)
968  ENDIF
969  ELSE
970  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
971  ENDIF
972  ELSE
973  CALL flagerror("Equations set is not associated.",err,error,*999)
974  ENDIF
975 
976  exits("EQUATIONS_SET_ANALYTIC_USER_PARAM_GET")
977  RETURN
978 999 errorsexits("EQUATIONS_SET_ANALYTIC_USER_PARAM_GET",err,error)
979  RETURN 1
980  END SUBROUTINE equations_set_analytic_user_param_get
981 
982  !
983  !================================================================================================================================
984  !
985 
987  SUBROUTINE equations_set_assemble(EQUATIONS_SET,ERR,ERROR,*)
988 
989  !Argument variables
990  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
991  INTEGER(INTG), INTENT(OUT) :: ERR
992  TYPE(varying_string), INTENT(OUT) :: ERROR
993  !Local Variables
994  TYPE(equations_type), POINTER :: EQUATIONS
995  TYPE(varying_string) :: LOCAL_ERROR
996 
997  enters("EQUATIONS_SET_ASSEMBLE",err,error,*999)
998 
999  IF(ASSOCIATED(equations_set)) THEN
1000  equations=>equations_set%EQUATIONS
1001  IF(ASSOCIATED(equations)) THEN
1002  IF(equations%EQUATIONS_FINISHED) THEN
1003  SELECT CASE(equations%TIME_DEPENDENCE)
1004  CASE(equations_static)
1005  SELECT CASE(equations%LINEARITY)
1006  CASE(equations_linear)
1007  SELECT CASE(equations_set%SOLUTION_METHOD)
1008  CASE(equations_set_fem_solution_method)
1009  CALL equations_set_assemble_static_linear_fem(equations_set,err,error,*999)
1010  CASE(equations_set_nodal_solution_method)
1011  CALL flagerror("Not implemented.",err,error,*999)
1012  CASE(equations_set_bem_solution_method)
1013  CALL flagerror("Not implemented.",err,error,*999)
1014  CASE(equations_set_fd_solution_method)
1015  CALL flagerror("Not implemented.",err,error,*999)
1016  CASE(equations_set_fv_solution_method)
1017  CALL flagerror("Not implemented.",err,error,*999)
1018  CASE(equations_set_gfem_solution_method)
1019  CALL flagerror("Not implemented.",err,error,*999)
1020  CASE(equations_set_gfv_solution_method)
1021  CALL flagerror("Not implemented.",err,error,*999)
1022  CASE DEFAULT
1023  local_error="The equations set solution method of "// &
1024  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1025  & " is invalid."
1026  CALL flagerror(local_error,err,error,*999)
1027  END SELECT
1028  CASE(equations_nonlinear)
1029  SELECT CASE(equations_set%SOLUTION_METHOD)
1030  CASE(equations_set_fem_solution_method)
1031  CALL equations_set_assemble_static_nonlinear_fem(equations_set,err,error,*999)
1032  CASE(equations_set_nodal_solution_method)
1033  CALL equationsset_assemblestaticnonlinearnodal(equations_set,err,error,*999)
1034  CASE(equations_set_bem_solution_method)
1035  CALL flagerror("Not implemented.",err,error,*999)
1036  CASE(equations_set_fd_solution_method)
1037  CALL flagerror("Not implemented.",err,error,*999)
1038  CASE(equations_set_fv_solution_method)
1039  CALL flagerror("Not implemented.",err,error,*999)
1040  CASE(equations_set_gfem_solution_method)
1041  CALL flagerror("Not implemented.",err,error,*999)
1042  CASE(equations_set_gfv_solution_method)
1043  CALL flagerror("Not implemented.",err,error,*999)
1044  CASE DEFAULT
1045  local_error="The equations set solution method of "// &
1046  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1047  & " is invalid."
1048  CALL flagerror(local_error,err,error,*999)
1049  END SELECT
1050  CASE(equations_nonlinear_bcs)
1051  CALL flagerror("Not implemented.",err,error,*999)
1052  CASE DEFAULT
1053  local_error="The equations linearity of "// &
1054  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
1055  CALL flagerror(local_error,err,error,*999)
1056  END SELECT
1057  CASE(equations_quasistatic)
1058 ! chrm, 17/09/09
1059  SELECT CASE(equations%LINEARITY)
1060  CASE(equations_linear)
1061  SELECT CASE(equations_set%SOLUTION_METHOD)
1062  CASE(equations_set_fem_solution_method)
1063  CALL equationsset_assemblequasistaticlinearfem(equations_set,err,error,*999)
1064  CASE(equations_set_bem_solution_method)
1065  CALL flagerror("Not implemented.",err,error,*999)
1066  CASE(equations_set_fd_solution_method)
1067  CALL flagerror("Not implemented.",err,error,*999)
1068  CASE(equations_set_fv_solution_method)
1069  CALL flagerror("Not implemented.",err,error,*999)
1070  CASE(equations_set_gfem_solution_method)
1071  CALL flagerror("Not implemented.",err,error,*999)
1072  CASE(equations_set_gfv_solution_method)
1073  CALL flagerror("Not implemented.",err,error,*999)
1074  CASE DEFAULT
1075  local_error="The equations set solution method of "// &
1076  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1077  & " is invalid."
1078  CALL flagerror(local_error,err,error,*999)
1079  END SELECT
1080  CASE(equations_nonlinear)
1081  CALL equationsset_assemblequasistaticnonlinearfem(equations_set,err,error,*999)
1082  CASE(equations_nonlinear_bcs)
1083  CALL flagerror("Not implemented.",err,error,*999)
1084  CASE DEFAULT
1085  local_error="The equations linearity of "// &
1086  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
1087  CALL flagerror(local_error,err,error,*999)
1088  END SELECT
1089  CASE(equations_first_order_dynamic,equations_second_order_dynamic)
1090  SELECT CASE(equations%LINEARITY)
1091  CASE(equations_linear)
1092  SELECT CASE(equations_set%SOLUTION_METHOD)
1093  CASE(equations_set_fem_solution_method)
1094  CALL equations_set_assemble_dynamic_linear_fem(equations_set,err,error,*999)
1095  CASE(equations_set_bem_solution_method)
1096  CALL flagerror("Not implemented.",err,error,*999)
1097  CASE(equations_set_fd_solution_method)
1098  CALL flagerror("Not implemented.",err,error,*999)
1099  CASE(equations_set_fv_solution_method)
1100  CALL flagerror("Not implemented.",err,error,*999)
1101  CASE(equations_set_gfem_solution_method)
1102  CALL flagerror("Not implemented.",err,error,*999)
1103  CASE(equations_set_gfv_solution_method)
1104  CALL flagerror("Not implemented.",err,error,*999)
1105  CASE DEFAULT
1106  local_error="The equations set solution method of "// &
1107  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1108  & " is invalid."
1109  CALL flagerror(local_error,err,error,*999)
1110  END SELECT
1111  CASE(equations_nonlinear)
1112  CALL flagerror("Not implemented.",err,error,*999)
1113  CASE(equations_nonlinear_bcs)
1114  CALL flagerror("Not implemented.",err,error,*999)
1115  CASE DEFAULT
1116  local_error="The equations set linearity of "// &
1117  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
1118  CALL flagerror(local_error,err,error,*999)
1119  END SELECT
1120  CASE(equations_time_stepping)
1121  CALL flagerror("Time stepping equations are not assembled.",err,error,*999)
1122  CASE DEFAULT
1123  local_error="The equations time dependence type of "// &
1124  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
1125  CALL flagerror(local_error,err,error,*999)
1126  END SELECT
1127  ELSE
1128  CALL flagerror("Equations have not been finished.",err,error,*999)
1129  ENDIF
1130  ELSE
1131  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1132  ENDIF
1133  ELSE
1134  CALL flagerror("Equations set is not associated.",err,error,*999)
1135  ENDIF
1136 
1137  exits("EQUATIONS_SET_ASSEMBLE")
1138  RETURN
1139 999 errorsexits("EQUATIONS_SET_ASSEMBLE",err,error)
1140  RETURN 1
1141  END SUBROUTINE equations_set_assemble
1142 
1143  !
1144  !================================================================================================================================
1145  !
1146 
1148  SUBROUTINE equations_set_assemble_dynamic_linear_fem(EQUATIONS_SET,ERR,ERROR,*)
1149 
1150  !Argument variables
1151  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1152  INTEGER(INTG), INTENT(OUT) :: ERR
1153  TYPE(varying_string), INTENT(OUT) :: ERROR
1154  !Local Variables
1155  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1156  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1157  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1158  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1159  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
1160  TYPE(equations_type), POINTER :: EQUATIONS
1161  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1162  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1163 
1164  enters("EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM",err,error,*999)
1165 
1166  IF(ASSOCIATED(equations_set)) THEN
1167  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1168  IF(ASSOCIATED(dependent_field)) THEN
1169  equations=>equations_set%EQUATIONS
1170  IF(ASSOCIATED(equations)) THEN
1171  equations_matrices=>equations%EQUATIONS_MATRICES
1172  IF(ASSOCIATED(equations_matrices)) THEN
1173  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1174  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
1175  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
1176  ENDIF
1177  !Initialise the matrices and rhs vector
1178  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_linear_only,0.0_dp,err,error,*999)
1179  !Assemble the elements
1180  !Allocate the element matrices
1181  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
1182  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1183  & mappings%ELEMENTS
1184  !Output timing information if required
1185  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1186  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
1187  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
1188  user_elapsed=user_time2(1)-user_time1(1)
1189  system_elapsed=system_time2(1)-system_time1(1)
1190  CALL write_string(general_output_type,"",err,error,*999)
1191  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
1192  & err,error,*999)
1193  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
1194  & err,error,*999)
1195  element_user_elapsed=0.0_sp
1196  element_system_elapsed=0.0_sp
1197  ENDIF
1198  number_of_times=0
1199  !Loop over the internal elements
1200  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1201  ne=elements_mapping%DOMAIN_LIST(element_idx)
1202  number_of_times=number_of_times+1
1203  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1204  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1205  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1206  ENDDO !element_idx
1207  !Output timing information if required
1208  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1209  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
1210  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
1211  user_elapsed=user_time3(1)-user_time2(1)
1212  system_elapsed=system_time3(1)-system_time2(1)
1213  element_user_elapsed=user_elapsed
1214  element_system_elapsed=system_elapsed
1215  CALL write_string(general_output_type,"",err,error,*999)
1216  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
1217  & err,error,*999)
1218  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
1219  & err,error,*999)
1220  ENDIF
1221  !Output timing information if required
1222  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1223  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
1224  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
1225  user_elapsed=user_time4(1)-user_time3(1)
1226  system_elapsed=system_time4(1)-system_time3(1)
1227  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
1228  & err,error,*999)
1229  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
1230  & err,error,*999)
1231  ENDIF
1232  !Loop over the boundary and ghost elements
1233  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1234  ne=elements_mapping%DOMAIN_LIST(element_idx)
1235  number_of_times=number_of_times+1
1236  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1237  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1238  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1239  ENDDO !element_idx
1240  !Output timing information if required
1241  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1242  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
1243  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
1244  user_elapsed=user_time5(1)-user_time4(1)
1245  system_elapsed=system_time5(1)-system_time4(1)
1246  element_user_elapsed=element_user_elapsed+user_elapsed
1247  element_system_elapsed=element_system_elapsed+user_elapsed
1248  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
1249  & err,error,*999)
1250  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
1251  & err,error,*999)
1252  IF(number_of_times>0) THEN
1253  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
1254  & element_user_elapsed/number_of_times,err,error,*999)
1255  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
1256  & element_system_elapsed/number_of_times,err,error,*999)
1257  ENDIF
1258  ENDIF
1259  !Finalise the element matrices
1260  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
1261  !Output equations matrices and RHS vector if required
1262  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
1263  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
1264  ENDIF
1265  !Output timing information if required
1266  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1267  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
1268  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
1269  user_elapsed=user_time6(1)-user_time1(1)
1270  system_elapsed=system_time6(1)-system_time1(1)
1271  CALL write_string(general_output_type,"",err,error,*999)
1272  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
1273  & err,error,*999)
1274  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
1275  & err,error,*999)
1276  ENDIF
1277  ELSE
1278  CALL flagerror("Equations matrices is not associated",err,error,*999)
1279  ENDIF
1280  ELSE
1281  CALL flagerror("Equations is not associated",err,error,*999)
1282  ENDIF
1283  ELSE
1284  CALL flagerror("Dependent field is not associated",err,error,*999)
1285  ENDIF
1286  ELSE
1287  CALL flagerror("Equations set is not associated",err,error,*999)
1288  ENDIF
1289 
1290  exits("EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM")
1291  RETURN
1292 999 errorsexits("EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM",err,error)
1293  RETURN 1
1294  END SUBROUTINE equations_set_assemble_dynamic_linear_fem
1295 
1296  !
1297  !================================================================================================================================
1298  !
1299 
1301  SUBROUTINE equations_set_assemble_static_linear_fem(EQUATIONS_SET,ERR,ERROR,*)
1302 
1303  !Argument variables
1304  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1305  INTEGER(INTG), INTENT(OUT) :: ERR
1306  TYPE(varying_string), INTENT(OUT) :: ERROR
1307  !Local Variables
1308  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1309  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1310  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1311  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1312  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
1313  TYPE(equations_type), POINTER :: EQUATIONS
1314  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1315  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1316 
1317 !#ifdef TAUPROF
1318 ! CHARACTER(28) :: CVAR
1319 ! INTEGER :: PHASE(2)= (/ 0, 0 /)
1320 ! SAVE PHASE
1321 !#endif
1322 
1323  enters("EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM",err,error,*999)
1324 
1325  IF(ASSOCIATED(equations_set)) THEN
1326  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1327  IF(ASSOCIATED(dependent_field)) THEN
1328  equations=>equations_set%EQUATIONS
1329  IF(ASSOCIATED(equations)) THEN
1330  equations_matrices=>equations%EQUATIONS_MATRICES
1331  IF(ASSOCIATED(equations_matrices)) THEN
1332  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1333  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
1334  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
1335  ENDIF
1336  !Initialise the matrices and rhs vector
1337 #ifdef TAUPROF
1338  CALL tau_static_phase_start("EQUATIONS_MATRICES_VALUES_INITIALISE()")
1339 #endif
1340  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_linear_only,0.0_dp,err,error,*999)
1341 #ifdef TAUPROF
1342  CALL tau_static_phase_stop("EQUATIONS_MATRICES_VALUES_INITIALISE()")
1343 #endif
1344  !Assemble the elements
1345  !Allocate the element matrices
1346 #ifdef TAUPROF
1347  CALL tau_static_phase_start("EQUATIONS_MATRICES_ELEMENT_INITIALISE()")
1348 #endif
1349  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
1350  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1351  & mappings%ELEMENTS
1352 #ifdef TAUPROF
1353  CALL tau_static_phase_stop("EQUATIONS_MATRICES_ELEMENT_INITIALISE()")
1354 #endif
1355  !Output timing information if required
1356  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1357  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
1358  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
1359  user_elapsed=user_time2(1)-user_time1(1)
1360  system_elapsed=system_time2(1)-system_time1(1)
1361  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
1362  & err,error,*999)
1363  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
1364  & err,error,*999)
1365  element_user_elapsed=0.0_sp
1366  element_system_elapsed=0.0_sp
1367  ENDIF
1368  number_of_times=0
1369  !Loop over the internal elements
1370 
1371 #ifdef TAUPROF
1372  CALL tau_static_phase_start("Internal Elements Loop")
1373 #endif
1374  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1375 !#ifdef TAUPROF
1376 ! WRITE (CVAR,'(a23,i3)') 'Internal Elements Loop ',element_idx
1377 ! CALL TAU_PHASE_CREATE_DYNAMIC(PHASE,CVAR)
1378 ! CALL TAU_PHASE_START(PHASE)
1379 !#endif
1380  ne=elements_mapping%DOMAIN_LIST(element_idx)
1381  number_of_times=number_of_times+1
1382  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1383  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1384  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1385 !#ifdef TAUPROF
1386 ! CALL TAU_PHASE_STOP(PHASE)
1387 !#endif
1388  ENDDO !element_idx
1389 #ifdef TAUPROF
1390  CALL tau_static_phase_stop("Internal Elements Loop")
1391 #endif
1392 
1393  !Output timing information if required
1394  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1395  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
1396  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
1397  user_elapsed=user_time3(1)-user_time2(1)
1398  system_elapsed=system_time3(1)-system_time2(1)
1399  element_user_elapsed=user_elapsed
1400  element_system_elapsed=system_elapsed
1401  CALL write_string(general_output_type,"",err,error,*999)
1402  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
1403  & err,error,*999)
1404  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
1405  & err,error,*999)
1406  ENDIF
1407  !Output timing information if required
1408  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1409  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
1410  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
1411  user_elapsed=user_time4(1)-user_time3(1)
1412  system_elapsed=system_time4(1)-system_time3(1)
1413  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
1414  & err,error,*999)
1415  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
1416  & err,error,*999)
1417  ENDIF
1418  !Loop over the boundary and ghost elements
1419 #ifdef TAUPROF
1420  CALL tau_static_phase_start("Boundary and Ghost Elements Loop")
1421 #endif
1422  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1423  ne=elements_mapping%DOMAIN_LIST(element_idx)
1424  number_of_times=number_of_times+1
1425  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1426  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1427  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1428  ENDDO !element_idx
1429 #ifdef TAUPROF
1430  CALL tau_static_phase_stop("Boundary and Ghost Elements Loop")
1431 #endif
1432  !Output timing information if required
1433  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1434  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
1435  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
1436  user_elapsed=user_time5(1)-user_time4(1)
1437  system_elapsed=system_time5(1)-system_time4(1)
1438  element_user_elapsed=element_user_elapsed+user_elapsed
1439  element_system_elapsed=element_system_elapsed+user_elapsed
1440  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
1441  & err,error,*999)
1442  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
1443  & err,error,*999)
1444  IF(number_of_times>0) THEN
1445  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
1446  & element_user_elapsed/number_of_times,err,error,*999)
1447  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
1448  & element_system_elapsed/number_of_times,err,error,*999)
1449  ENDIF
1450  ENDIF
1451  !Finalise the element matrices
1452 #ifdef TAUPROF
1453  CALL tau_static_phase_start("EQUATIONS_MATRICES_ELEMENT_FINALISE()")
1454 #endif
1455  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
1456 #ifdef TAUPROF
1457  CALL tau_static_phase_stop("EQUATIONS_MATRICES_ELEMENT_FINALISE()")
1458 #endif
1459  !Output equations matrices and vector if required
1460  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
1461  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
1462  ENDIF
1463  !Output timing information if required
1464  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1465  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
1466  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
1467  user_elapsed=user_time6(1)-user_time1(1)
1468  system_elapsed=system_time6(1)-system_time1(1)
1469  CALL write_string(general_output_type,"",err,error,*999)
1470  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
1471  & err,error,*999)
1472  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
1473  & err,error,*999)
1474  ENDIF
1475  ELSE
1476  CALL flagerror("Equations matrices is not associated",err,error,*999)
1477  ENDIF
1478  ELSE
1479  CALL flagerror("Equations is not associated",err,error,*999)
1480  ENDIF
1481  ELSE
1482  CALL flagerror("Dependent field is not associated",err,error,*999)
1483  ENDIF
1484  ELSE
1485  CALL flagerror("Equations set is not associated",err,error,*999)
1486  ENDIF
1487 
1488  exits("EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM")
1489  RETURN
1490 999 errorsexits("EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM",err,error)
1491  RETURN 1
1492  END SUBROUTINE equations_set_assemble_static_linear_fem
1493 
1494  !
1495  !================================================================================================================================
1496  !
1497 
1499  SUBROUTINE equations_set_assemble_static_nonlinear_fem(EQUATIONS_SET,ERR,ERROR,*)
1500 
1501  !Argument variables
1502  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1503  INTEGER(INTG), INTENT(OUT) :: ERR
1504  TYPE(varying_string), INTENT(OUT) :: ERROR
1505  !Local Variables
1506  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1507  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1508  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1509  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1510  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
1511  TYPE(equations_type), POINTER :: EQUATIONS
1512  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1513  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1514 
1515  enters("EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM",err,error,*999)
1516 
1517  IF(ASSOCIATED(equations_set)) THEN
1518  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1519  IF(ASSOCIATED(dependent_field)) THEN
1520  equations=>equations_set%EQUATIONS
1521  IF(ASSOCIATED(equations)) THEN
1522  equations_matrices=>equations%EQUATIONS_MATRICES
1523  IF(ASSOCIATED(equations_matrices)) THEN
1524  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1525  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
1526  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
1527  ENDIF
1528  !Initialise the matrices and rhs vector
1529  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_nonlinear_only,0.0_dp,err,error,*999)
1530  !Assemble the elements
1531  !Allocate the element matrices
1532  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
1533  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1534  & mappings%ELEMENTS
1535  !Output timing information if required
1536  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1537  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
1538  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
1539  user_elapsed=user_time2(1)-user_time1(1)
1540  system_elapsed=system_time2(1)-system_time1(1)
1541  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
1542  & err,error,*999)
1543  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
1544  & err,error,*999)
1545  element_user_elapsed=0.0_sp
1546  element_system_elapsed=0.0_sp
1547  ENDIF
1548  number_of_times=0
1549  !Loop over the internal elements
1550  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1551  ne=elements_mapping%DOMAIN_LIST(element_idx)
1552  number_of_times=number_of_times+1
1553  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1554  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
1555  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1556  ENDDO !element_idx
1557  !Output timing information if required
1558  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1559  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
1560  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
1561  user_elapsed=user_time3(1)-user_time2(1)
1562  system_elapsed=system_time3(1)-system_time2(1)
1563  element_user_elapsed=user_elapsed
1564  element_system_elapsed=system_elapsed
1565  CALL write_string(general_output_type,"",err,error,*999)
1566  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
1567  & err,error,*999)
1568  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
1569  & err,error,*999)
1570  ENDIF
1571  !Output timing information if required
1572  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1573  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
1574  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
1575  user_elapsed=user_time4(1)-user_time3(1)
1576  system_elapsed=system_time4(1)-system_time3(1)
1577  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
1578  & err,error,*999)
1579  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
1580  & err,error,*999)
1581  ENDIF
1582  !Loop over the boundary and ghost elements
1583  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1584  ne=elements_mapping%DOMAIN_LIST(element_idx)
1585  number_of_times=number_of_times+1
1586  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1587  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
1588  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1589  ENDDO !element_idx
1590  !Output timing information if required
1591  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1592  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
1593  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
1594  user_elapsed=user_time5(1)-user_time4(1)
1595  system_elapsed=system_time5(1)-system_time4(1)
1596  element_user_elapsed=element_user_elapsed+user_elapsed
1597  element_system_elapsed=element_system_elapsed+user_elapsed
1598  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
1599  & err,error,*999)
1600  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
1601  & err,error,*999)
1602  IF(number_of_times>0) THEN
1603  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
1604  & element_user_elapsed/number_of_times,err,error,*999)
1605  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
1606  & element_system_elapsed/number_of_times,err,error,*999)
1607  ENDIF
1608  ENDIF
1609  !Finalise the element matrices
1610  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
1611  !Output equations matrices and RHS vector if required
1612  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
1613  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
1614  ENDIF
1615  !Output timing information if required
1616  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1617  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
1618  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
1619  user_elapsed=user_time6(1)-user_time1(1)
1620  system_elapsed=system_time6(1)-system_time1(1)
1621  CALL write_string(general_output_type,"",err,error,*999)
1622  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
1623  & err,error,*999)
1624  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
1625  & err,error,*999)
1626  ENDIF
1627  ELSE
1628  CALL flagerror("Equations matrices is not associated",err,error,*999)
1629  ENDIF
1630  ELSE
1631  CALL flagerror("Equations is not associated",err,error,*999)
1632  ENDIF
1633  ELSE
1634  CALL flagerror("Dependent field is not associated",err,error,*999)
1635  ENDIF
1636  ELSE
1637  CALL flagerror("Equations set is not associated",err,error,*999)
1638  ENDIF
1639 
1640  exits("EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM")
1641  RETURN
1642 999 errorsexits("EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM",err,error)
1643  RETURN 1
1644  END SUBROUTINE equations_set_assemble_static_nonlinear_fem
1645 
1646  !
1647  !================================================================================================================================
1648  !
1649 
1652  SUBROUTINE equationsset_assemblequasistaticnonlinearfem(EQUATIONS_SET,ERR,ERROR,*)
1653  !Argument variables
1654  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1655  INTEGER(INTG), INTENT(OUT) :: ERR
1656  TYPE(varying_string), INTENT(OUT) :: ERROR
1657 
1658  enters("EquationsSet_AssembleQuasistaticNonlinearFEM",err,error,*999)
1659 
1660  ! currently no difference
1661  CALL equations_set_assemble_static_nonlinear_fem(equations_set,err,error,*999)
1662 
1663  RETURN
1664 999 errors("EquationsSet_AssembleQuasistaticNonlinearFEM",err,error)
1665  exits("EquationsSet_AssembleQuasistaticNonlinearFEM")
1666  RETURN 1
1667 
1668  END SUBROUTINE equationsset_assemblequasistaticnonlinearfem
1669 
1670  !
1671  !================================================================================================================================
1672  !
1673 
1675  SUBROUTINE equationsset_assemblequasistaticlinearfem(EQUATIONS_SET,ERR,ERROR,*)
1676 
1677  !Argument variables
1678  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1679  INTEGER(INTG), INTENT(OUT) :: ERR
1680  TYPE(varying_string), INTENT(OUT) :: ERROR
1681  !Local Variables
1682  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1683  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1684  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1685  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1686  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
1687  TYPE(equations_type), POINTER :: EQUATIONS
1688  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1689  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1690 
1691  enters("EquationsSet_AssembleQuasistaticLinearFEM",err,error,*999)
1692 
1693  IF(ASSOCIATED(equations_set)) THEN
1694  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1695  IF(ASSOCIATED(dependent_field)) THEN
1696  equations=>equations_set%EQUATIONS
1697  IF(ASSOCIATED(equations)) THEN
1698  equations_matrices=>equations%EQUATIONS_MATRICES
1699  IF(ASSOCIATED(equations_matrices)) THEN
1700  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1701  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
1702  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
1703  ENDIF
1704  !Initialise the matrices and rhs vector
1705  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_linear_only,0.0_dp,err,error,*999)
1706  !Assemble the elements
1707  !Allocate the element matrices
1708  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
1709  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1710  & mappings%ELEMENTS
1711  !Output timing information if required
1712  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1713  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
1714  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
1715  user_elapsed=user_time2(1)-user_time1(1)
1716  system_elapsed=system_time2(1)-system_time1(1)
1717  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
1718  & err,error,*999)
1719  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
1720  & err,error,*999)
1721  element_user_elapsed=0.0_sp
1722  element_system_elapsed=0.0_sp
1723  ENDIF
1724  number_of_times=0
1725  !Loop over the internal elements
1726  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1727  ne=elements_mapping%DOMAIN_LIST(element_idx)
1728  number_of_times=number_of_times+1
1729  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1730  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1731  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1732  ENDDO !element_idx
1733  !Output timing information if required
1734  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1735  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
1736  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
1737  user_elapsed=user_time3(1)-user_time2(1)
1738  system_elapsed=system_time3(1)-system_time2(1)
1739  element_user_elapsed=user_elapsed
1740  element_system_elapsed=system_elapsed
1741  CALL write_string(general_output_type,"",err,error,*999)
1742  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
1743  & err,error,*999)
1744  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
1745  & err,error,*999)
1746  ENDIF
1747  !Output timing information if required
1748  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1749  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
1750  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
1751  user_elapsed=user_time4(1)-user_time3(1)
1752  system_elapsed=system_time4(1)-system_time3(1)
1753  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
1754  & err,error,*999)
1755  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
1756  & err,error,*999)
1757  ENDIF
1758  !Loop over the boundary and ghost elements
1759  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1760  ne=elements_mapping%DOMAIN_LIST(element_idx)
1761  number_of_times=number_of_times+1
1762  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
1763  CALL equations_set_finite_element_calculate(equations_set,ne,err,error,*999)
1764  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
1765  ENDDO !element_idx
1766  !Output timing information if required
1767  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1768  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
1769  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
1770  user_elapsed=user_time5(1)-user_time4(1)
1771  system_elapsed=system_time5(1)-system_time4(1)
1772  element_user_elapsed=element_user_elapsed+user_elapsed
1773  element_system_elapsed=element_system_elapsed+user_elapsed
1774  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
1775  & err,error,*999)
1776  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
1777  & err,error,*999)
1778  IF(number_of_times>0) THEN
1779  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
1780  & element_user_elapsed/number_of_times,err,error,*999)
1781  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
1782  & element_system_elapsed/number_of_times,err,error,*999)
1783  ENDIF
1784  ENDIF
1785  !Finalise the element matrices
1786  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
1787  !Output equations matrices and RHS vector if required
1788  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
1789  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
1790  ENDIF
1791  !Output timing information if required
1792  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
1793  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
1794  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
1795  user_elapsed=user_time6(1)-user_time1(1)
1796  system_elapsed=system_time6(1)-system_time1(1)
1797  CALL write_string(general_output_type,"",err,error,*999)
1798  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
1799  & err,error,*999)
1800  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
1801  & err,error,*999)
1802  ENDIF
1803  ELSE
1804  CALL flagerror("Equations matrices is not associated",err,error,*999)
1805  ENDIF
1806  ELSE
1807  CALL flagerror("Equations is not associated",err,error,*999)
1808  ENDIF
1809  ELSE
1810  CALL flagerror("Dependent field is not associated",err,error,*999)
1811  ENDIF
1812  ELSE
1813  CALL flagerror("Equations set is not associated",err,error,*999)
1814  ENDIF
1815 
1816  exits("EquationsSet_AssembleQuasistaticLinearFEM")
1817  RETURN
1818 999 errorsexits("EquationsSet_AssembleQuasistaticLinearFEM",err,error)
1819  RETURN 1
1820  END SUBROUTINE equationsset_assemblequasistaticlinearfem
1821 
1822  !
1823  !================================================================================================================================
1824  !
1825 
1827  SUBROUTINE equations_set_backsubstitute(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
1828 
1829  !Argument variables
1830  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1831  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
1832  INTEGER(INTG), INTENT(OUT) :: ERR
1833  TYPE(varying_string), INTENT(OUT) :: ERROR
1834  !Local Variables
1835  INTEGER(INTG) :: equations_column_idx,equations_column_number,equations_matrix_idx,equations_row_number, &
1836  & EQUATIONS_STORAGE_TYPE,rhs_boundary_condition,rhs_global_dof,rhs_variable_dof,RHS_VARIABLE_TYPE,variable_dof,VARIABLE_TYPE
1837  INTEGER(INTG), POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
1838  REAL(DP) :: DEPENDENT_VALUE,MATRIX_VALUE,RHS_VALUE,SOURCE_VALUE
1839  REAL(DP), POINTER :: DEPENDENT_PARAMETERS(:),EQUATIONS_MATRIX_DATA(:),SOURCE_VECTOR_DATA(:)
1840  TYPE(boundary_conditions_variable_type), POINTER :: RHS_BOUNDARY_CONDITIONS
1841  TYPE(domain_mapping_type), POINTER :: COLUMN_DOMAIN_MAPPING,RHS_DOMAIN_MAPPING
1842  TYPE(distributed_matrix_type), POINTER :: EQUATIONS_DISTRIBUTED_MATRIX
1843  TYPE(distributed_vector_type), POINTER :: SOURCE_DISTRIBUTED_VECTOR
1844  TYPE(equations_type), POINTER :: EQUATIONS
1845  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1846  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
1847  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
1848  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
1849  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1850  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1851  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
1852  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
1853  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
1854  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1855  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,RHS_VARIABLE
1856  TYPE(varying_string) :: LOCAL_ERROR
1857 
1858  NULLIFY(dependent_parameters)
1859  NULLIFY(equations_matrix_data)
1860  NULLIFY(source_vector_data)
1861 
1862  enters("EQUATIONS_SET_BACKSUBSTITUTE",err,error,*999)
1863 
1864  IF(ASSOCIATED(equations_set)) THEN
1865  IF(equations_set%EQUATIONS_SET_FINISHED) THEN
1866  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1867  IF(ASSOCIATED(dependent_field)) THEN
1868  equations=>equations_set%EQUATIONS
1869  IF(ASSOCIATED(equations)) THEN
1870  equations_matrices=>equations%EQUATIONS_MATRICES
1871  IF(ASSOCIATED(equations_matrices)) THEN
1872  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1873  IF(ASSOCIATED(dynamic_matrices)) THEN
1874  !CALL FlagError("Not implemented.",ERR,ERROR,*999)
1875  ELSE
1876  linear_matrices=>equations_matrices%LINEAR_MATRICES
1877  IF(ASSOCIATED(linear_matrices)) THEN
1878  equations_mapping=>equations%EQUATIONS_MAPPING
1879  IF(ASSOCIATED(equations_mapping)) THEN
1880  linear_mapping=>equations_mapping%LINEAR_MAPPING
1881  IF(ASSOCIATED(linear_mapping)) THEN
1882  rhs_mapping=>equations_mapping%RHS_MAPPING
1883  source_mapping=>equations_mapping%SOURCE_MAPPING
1884  IF(ASSOCIATED(rhs_mapping)) THEN
1885  IF(ASSOCIATED(boundary_conditions)) THEN
1886  IF(ASSOCIATED(source_mapping)) THEN
1887  source_vector=>equations_matrices%SOURCE_VECTOR
1888  IF(ASSOCIATED(source_vector)) THEN
1889  source_distributed_vector=>source_vector%VECTOR
1890  IF(ASSOCIATED(source_distributed_vector)) THEN
1891  CALL distributed_vector_data_get(source_distributed_vector,source_vector_data,err,error,*999)
1892  ELSE
1893  CALL flagerror("Source distributed vector is not associated.",err,error,*999)
1894  ENDIF
1895  ELSE
1896  CALL flagerror("Source vector is not associated.",err,error,*999)
1897  ENDIF
1898  ENDIF
1899  rhs_variable=>rhs_mapping%RHS_VARIABLE
1900  IF(ASSOCIATED(rhs_variable)) THEN
1901  rhs_variable_type=rhs_variable%VARIABLE_TYPE
1902  rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
1903  IF(ASSOCIATED(rhs_domain_mapping)) THEN
1904  CALL boundary_conditions_variable_get(boundary_conditions,rhs_variable,rhs_boundary_conditions, &
1905  & err,error,*999)
1906  IF(ASSOCIATED(rhs_boundary_conditions)) THEN
1907  !Loop over the equations matrices
1908  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1909  dependent_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
1910  IF(ASSOCIATED(dependent_variable)) THEN
1911  variable_type=dependent_variable%VARIABLE_TYPE
1912  !Get the dependent field variable parameters
1913  CALL field_parametersetdataget(dependent_field,variable_type,field_values_set_type, &
1914  & dependent_parameters,err,error,*999)
1915  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
1916  IF(ASSOCIATED(equations_matrix)) THEN
1917  column_domain_mapping=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
1918  & column_dofs_mapping
1919  IF(ASSOCIATED(column_domain_mapping)) THEN
1920  equations_distributed_matrix=>equations_matrix%MATRIX
1921  IF(ASSOCIATED(equations_distributed_matrix)) THEN
1922  CALL distributed_matrix_storage_type_get(equations_distributed_matrix, &
1923  & equations_storage_type,err,error,*999)
1924  CALL distributed_matrix_data_get(equations_distributed_matrix,equations_matrix_data, &
1925  & err,error,*999)
1926  SELECT CASE(equations_storage_type)
1927  CASE(distributed_matrix_block_storage_type)
1928  !Loop over the non ghosted rows in the equations set
1929  DO equations_row_number=1,equations_mapping%NUMBER_OF_ROWS
1930  rhs_value=0.0_dp
1931  rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
1932  rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
1933  rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
1934  !For free RHS DOFs, set the right hand side field values by multiplying the
1935  !row by the dependent variable value
1936  SELECT CASE(rhs_boundary_condition)
1937  CASE(boundary_condition_dof_free)
1938  !Back substitute
1939  !Loop over the local columns of the equations matrix
1940  DO equations_column_idx=1,column_domain_mapping%TOTAL_NUMBER_OF_LOCAL
1941  equations_column_number=column_domain_mapping%LOCAL_TO_GLOBAL_MAP( &
1942  & equations_column_idx)
1943  variable_dof=equations_column_idx
1944  matrix_value=equations_matrix_data(equations_row_number+ &
1945  & (equations_column_number-1)*equations_matrices%TOTAL_NUMBER_OF_ROWS)
1946  dependent_value=dependent_parameters(variable_dof)
1947  rhs_value=rhs_value+matrix_value*dependent_value
1948  ENDDO !equations_column_idx
1949  CASE(boundary_condition_dof_fixed)
1950  !Do nothing
1951  CASE(boundary_condition_dof_mixed)
1952  !Robin or is it Cauchy??? boundary conditions
1953  CALL flagerror("Not implemented.",err,error,*999)
1954  CASE DEFAULT
1955  local_error="The RHS variable boundary condition of "// &
1956  & trim(number_to_vstring(rhs_boundary_condition,"*",err,error))// &
1957  & " for RHS variable dof number "// &
1958  & trim(number_to_vstring(rhs_variable_dof,"*",err,error))//" is invalid."
1959  CALL flagerror(local_error,err,error,*999)
1960  END SELECT
1961  IF(ASSOCIATED(source_mapping)) THEN
1962  source_value=source_vector_data(equations_row_number)
1963  rhs_value=rhs_value-source_value
1964  ENDIF
1965  CALL field_parametersetupdatelocaldof(dependent_field,rhs_variable_type, &
1966  & field_values_set_type,rhs_variable_dof,rhs_value,err,error,*999)
1967  ENDDO !equations_row_number
1968  CASE(distributed_matrix_diagonal_storage_type)
1969  CALL flagerror("Not implemented.",err,error,*999)
1970  CASE(distributed_matrix_column_major_storage_type)
1971  CALL flagerror("Not implemented.",err,error,*999)
1972  CASE(distributed_matrix_row_major_storage_type)
1973  CALL flagerror("Not implemented.",err,error,*999)
1974  CASE(distributed_matrix_compressed_row_storage_type)
1975  CALL distributed_matrix_storage_locations_get(equations_distributed_matrix, &
1976  & row_indices,column_indices,err,error,*999)
1977  !Loop over the non-ghosted rows in the equations set
1978  DO equations_row_number=1,equations_mapping%NUMBER_OF_ROWS
1979  rhs_value=0.0_dp
1980  rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
1981  rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
1982  rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
1983  SELECT CASE(rhs_boundary_condition)
1984  CASE(boundary_condition_dof_free)
1985  !Back substitute
1986  !Loop over the local columns of the equations matrix
1987  DO equations_column_idx=row_indices(equations_row_number), &
1988  row_indices(equations_row_number+1)-1
1989  equations_column_number=column_indices(equations_column_idx)
1990  variable_dof=equations_column_idx-row_indices(equations_row_number)+1
1991  matrix_value=equations_matrix_data(equations_column_idx)
1992  dependent_value=dependent_parameters(variable_dof)
1993  rhs_value=rhs_value+matrix_value*dependent_value
1994  ENDDO !equations_column_idx
1995  CASE(boundary_condition_dof_fixed)
1996  !Do nothing
1997  CASE(boundary_condition_dof_mixed)
1998  !Robin or is it Cauchy??? boundary conditions
1999  CALL flagerror("Not implemented.",err,error,*999)
2000  CASE DEFAULT
2001  local_error="The global boundary condition of "// &
2002  & trim(number_to_vstring(rhs_boundary_condition,"*",err,error))// &
2003  & " for RHS variable dof number "// &
2004  & trim(number_to_vstring(rhs_variable_dof,"*",err,error))//" is invalid."
2005  CALL flagerror(local_error,err,error,*999)
2006  END SELECT
2007  IF(ASSOCIATED(source_mapping)) THEN
2008  source_value=source_vector_data(equations_row_number)
2009  rhs_value=rhs_value-source_value
2010  ENDIF
2011  CALL field_parametersetupdatelocaldof(dependent_field,rhs_variable_type, &
2012  & field_values_set_type,rhs_variable_dof,rhs_value,err,error,*999)
2013  ENDDO !equations_row_number
2014  CASE(distributed_matrix_compressed_column_storage_type)
2015  CALL flagerror("Not implemented.",err,error,*999)
2016  CASE(distributed_matrix_row_column_storage_type)
2017  CALL flagerror("Not implemented.",err,error,*999)
2018  CASE DEFAULT
2019  local_error="The matrix storage type of "// &
2020  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
2021  CALL flagerror(local_error,err,error,*999)
2022  END SELECT
2023  CALL distributed_matrix_data_restore(equations_distributed_matrix,equations_matrix_data, &
2024  & err,error,*999)
2025  ELSE
2026  CALL flagerror("Equations matrix distributed matrix is not associated.",err,error,*999)
2027  ENDIF
2028  ELSE
2029  CALL flagerror("Equations column domain mapping is not associated.",err,error,*999)
2030  ENDIF
2031  ELSE
2032  CALL flagerror("Equations equations matrix is not associated.",err,error,*999)
2033  ENDIF
2034  !Restore the dependent field variable parameters
2035  CALL field_parametersetdatarestore(dependent_field,variable_type,field_values_set_type, &
2036  & dependent_parameters,err,error,*999)
2037  ELSE
2038  CALL flagerror("Dependent variable is not associated.",err,error,*999)
2039  ENDIF
2040  ENDDO !equations_matrix_idx
2041  !Start the update of the field parameters
2042  CALL field_parametersetupdatestart(dependent_field,rhs_variable_type,field_values_set_type, &
2043  & err,error,*999)
2044  !Finish the update of the field parameters
2045  CALL field_parametersetupdatefinish(dependent_field,rhs_variable_type,field_values_set_type, &
2046  & err,error,*999)
2047  ELSE
2048  CALL flagerror("RHS boundary conditions variable is not associated.",err,error,*999)
2049  ENDIF
2050  ELSE
2051  CALL flagerror("RHS variable domain mapping is not associated.",err,error,*999)
2052  ENDIF
2053  ELSE
2054  CALL flagerror("RHS variable is not associated.",err,error,*999)
2055  ENDIF
2056  IF(ASSOCIATED(source_mapping)) THEN
2057  CALL distributed_vector_data_restore(source_distributed_vector,source_vector_data,err,error,*999)
2058  ENDIF
2059  ELSE
2060  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
2061  ENDIF
2062  ELSE
2063  CALL flagerror("Equations mapping RHS mappings is not associated.",err,error,*999)
2064  ENDIF
2065  ELSE
2066  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
2067  ENDIF
2068  ELSE
2069  CALL flagerror("Equations mapping is not associated.",err,error,*999)
2070  ENDIF
2071  ELSE
2072  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
2073  ENDIF
2074  ENDIF
2075  ELSE
2076  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2077  ENDIF
2078  ELSE
2079  CALL flagerror("Equations is not associated.",err,error,*999)
2080  ENDIF
2081  ELSE
2082  CALL flagerror("Dependent field is not associated.",err,error,*999)
2083  ENDIF
2084  ELSE
2085  CALL flagerror("Equations set has not been finished.",err,error,*999)
2086  ENDIF
2087  ELSE
2088  CALL flagerror("Equations set is not associated",err,error,*999)
2089  ENDIF
2090 
2091  exits("EQUATIONS_SET_BACKSUBSTITUTE")
2092  RETURN
2093 999 errorsexits("EQUATIONS_SET_BACKSUBSTITUTE",err,error)
2094  RETURN 1
2095 
2096  END SUBROUTINE equations_set_backsubstitute
2097 
2098  !
2099  !================================================================================================================================
2100  !
2101 
2103  SUBROUTINE equations_set_nonlinear_rhs_update(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
2104 
2105  !Argument variables
2106  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2107  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
2108  INTEGER(INTG), INTENT(OUT) :: ERR
2109  TYPE(varying_string), INTENT(OUT) :: ERROR
2110  !Local Variables
2111  INTEGER(INTG) :: variable_dof,row_idx,VARIABLE_TYPE,rhs_global_dof,rhs_boundary_condition,equations_matrix_idx
2112  REAL(DP) :: VALUE
2113  TYPE(equations_type), POINTER :: EQUATIONS
2114  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2115  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
2116  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
2117  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2118  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2119  TYPE(distributed_vector_type), POINTER :: RESIDUAL_VECTOR
2120  TYPE(field_type), POINTER :: RHS_FIELD
2121  TYPE(field_variable_type), POINTER :: RHS_VARIABLE,RESIDUAL_VARIABLE
2122  TYPE(boundary_conditions_variable_type), POINTER :: RHS_BOUNDARY_CONDITIONS
2123  TYPE(domain_mapping_type), POINTER :: RHS_DOMAIN_MAPPING
2124  TYPE(varying_string) :: LOCAL_ERROR
2125 
2126  enters("EQUATIONS_SET_NONLINEAR_RHS_UPDATE",err,error,*999)
2127 
2128  IF(ASSOCIATED(equations_set)) THEN
2129  equations=>equations_set%EQUATIONS
2130  IF(ASSOCIATED(equations)) THEN
2131  equations_mapping=>equations%EQUATIONS_MAPPING
2132  IF(ASSOCIATED(equations_mapping)) THEN
2133  rhs_mapping=>equations_mapping%RHS_MAPPING
2134  IF(ASSOCIATED(rhs_mapping)) THEN
2135  rhs_variable=>rhs_mapping%RHS_VARIABLE
2136  IF(ASSOCIATED(rhs_variable)) THEN
2137  !Get the right hand side variable
2138  rhs_field=>rhs_variable%FIELD
2139  variable_type=rhs_variable%VARIABLE_TYPE
2140  ELSE
2141  CALL flagerror("RHS mapping RHS variable is not associated.",err,error,*999)
2142  ENDIF
2143  ELSE
2144  CALL flagerror("Equations mapping RHS mapping is not associated.",err,error,*999)
2145  ENDIF
2146  IF(ASSOCIATED(rhs_field)) THEN
2147  IF(ASSOCIATED(boundary_conditions)) THEN
2148  rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
2149  IF(ASSOCIATED(rhs_domain_mapping)) THEN
2150  CALL boundary_conditions_variable_get(boundary_conditions,rhs_variable,rhs_boundary_conditions, &
2151  & err,error,*999)
2152  IF(ASSOCIATED(rhs_boundary_conditions)) THEN
2153  !Get the equations residual vector
2154  equations_matrices=>equations%EQUATIONS_MATRICES
2155  IF(ASSOCIATED(equations_matrices)) THEN
2156  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2157  IF(ASSOCIATED(nonlinear_matrices)) THEN
2158  residual_vector=>nonlinear_matrices%RESIDUAL
2159  IF(ASSOCIATED(residual_vector)) THEN
2160  !Get mapping from equations rows to field dofs
2161  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2162  IF(ASSOCIATED(nonlinear_mapping)) THEN
2163  DO equations_matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
2164  residual_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(equations_matrix_idx)%VARIABLE
2165  IF(ASSOCIATED(residual_variable)) THEN
2166  DO row_idx=1,equations_mapping%NUMBER_OF_ROWS
2167  variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(row_idx)
2168  rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(variable_dof)
2169  rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
2170  SELECT CASE(rhs_boundary_condition)
2171  CASE(boundary_condition_dof_free)
2172  !Add residual to field value
2173  CALL distributed_vector_values_get(residual_vector,row_idx,VALUE,err,error,*999)
2174  CALL field_parametersetupdatelocaldof(rhs_field,variable_type,field_values_set_type, &
2175  & variable_dof,VALUE,err,error,*999)
2176  CASE(boundary_condition_dof_fixed)
2177  !Do nothing
2178  CASE(boundary_condition_dof_mixed)
2179  CALL flagerror("Not implemented.",err,error,*999)
2180  CASE DEFAULT
2181  local_error="The RHS variable boundary condition of "// &
2182  & trim(number_to_vstring(rhs_boundary_condition,"*",err,error))// &
2183  & " for RHS variable dof number "// &
2184  & trim(number_to_vstring(variable_dof,"*",err,error))//" is invalid."
2185  CALL flagerror(local_error,err,error,*999)
2186  END SELECT
2187  ENDDO
2188  ELSE
2189  CALL flagerror("Residual variable is not associated.",err,error,*999)
2190  ENDIF
2191  ENDDO !equations_matrix_idx
2192  ELSE
2193  CALL flagerror("Nonlinear mapping is not associated.",err,error,*999)
2194  ENDIF
2195  ELSE
2196  CALL flagerror("Residual vector is not associated.",err,error,*999)
2197  ENDIF
2198  ELSE
2199  CALL flagerror("Nonlinear matrices is not associated.",err,error,*999)
2200  ENDIF
2201  ELSE
2202  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2203  ENDIF
2204  ELSE
2205  CALL flagerror("RHS boundary conditions variable is not associated.",err,error,*999)
2206  ENDIF
2207  ELSE
2208  CALL flagerror("RHS variable domain mapping is not associated.",err,error,*999)
2209  ENDIF
2210  ELSE
2211  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
2212  ENDIF
2213  CALL field_parametersetupdatestart(rhs_field,variable_type,field_values_set_type,err,error,*999)
2214  CALL field_parametersetupdatefinish(rhs_field,variable_type,field_values_set_type,err,error,*999)
2215  ELSE
2216  CALL flagerror("RHS variable field is not associated.",err,error,*999)
2217  ENDIF
2218  ELSE
2219  CALL flagerror("Equations mapping is not associated.",err,error,*999)
2220  ENDIF
2221  ELSE
2222  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2223  ENDIF
2224  ELSE
2225  CALL flagerror("Equations set is not associated.",err,error,*999)
2226  ENDIF
2227 
2228  exits("EQUATIONS_SET_NONLINEAR_RHS_UPDATE")
2229  RETURN
2230 999 errorsexits("EQUATIONS_SET_NONLINEAR_RHS_UPDATE",err,error)
2231  RETURN 1
2232 
2233  END SUBROUTINE equations_set_nonlinear_rhs_update
2234 
2235  !
2236  !================================================================================================================================
2237  !
2238 
2240  SUBROUTINE equations_set_boundary_conditions_analytic(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
2241 
2242  !Argument variables
2243  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2244  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
2245  INTEGER(INTG), INTENT(OUT) :: ERR
2246  TYPE(varying_string), INTENT(OUT) :: ERROR
2247  !Local Variables
2248  TYPE(varying_string) :: LOCAL_ERROR
2249 
2250  enters("EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC",err,error,*999)
2251 
2252  IF(ASSOCIATED(equations_set)) THEN
2253  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2254  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2255  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
2256  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
2257  END IF
2258  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2259  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
2260  IF(equations_set%ANALYTIC%ANALYTIC_FINISHED) THEN
2261  SELECT CASE(equations_set%SPECIFICATION(1))
2262  CASE(equations_set_elasticity_class)
2263  CALL elasticity_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2264  CASE(equations_set_fluid_mechanics_class)
2265  CALL fluidmechanics_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2266  CASE(equations_set_electromagnetics_class)
2267  CALL flagerror("Not implemented.",err,error,*999)
2268  CASE(equations_set_classical_field_class)
2269  CALL classicalfield_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2270  CASE(equations_set_bioelectrics_class)
2271  CALL flagerror("Not implemented.",err,error,*999)
2272  CASE(equations_set_modal_class)
2273  CALL flagerror("Not implemented.",err,error,*999)
2274  CASE(equations_set_multi_physics_class)
2275  CALL flagerror("Not implemented.",err,error,*999)
2276  CASE DEFAULT
2277  local_error="The first equations set specification of "//trim(number_to_vstring(equations_set%SPECIFICATION(1),"*", &
2278  & err,error))//" is invalid."
2279  CALL flagerror(local_error,err,error,*999)
2280  END SELECT
2281  ELSE
2282  CALL flagerror("Equations set analytic has not been finished.",err,error,*999)
2283  ENDIF
2284  ELSE
2285  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
2286  ENDIF
2287  ELSE
2288  CALL flagerror("Equations set dependent has not been finished.",err,error,*999)
2289  ENDIF
2290  ELSE
2291  CALL flagerror("Equations set is not associated.",err,error,*999)
2292  ENDIF
2293 
2294  exits("EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC")
2295  RETURN
2296 999 errorsexits("EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC",err,error)
2297  RETURN 1
2298  END SUBROUTINE equations_set_boundary_conditions_analytic
2299 
2300  !
2301  !================================================================================================================================
2302  !
2303 
2305  SUBROUTINE equations_set_create_finish(EQUATIONS_SET,ERR,ERROR,*)
2306 
2307  !Argument variables
2308  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2309  INTEGER(INTG), INTENT(OUT) :: ERR
2310  TYPE(varying_string), INTENT(OUT) :: ERROR
2311  !Local Variables
2312  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
2313 
2314  enters("EQUATIONS_SET_CREATE_FINISH",err,error,*999)
2315 
2316  IF(ASSOCIATED(equations_set)) THEN
2317  IF(equations_set%EQUATIONS_SET_FINISHED) THEN
2318  CALL flagerror("Equations set has already been finished.",err,error,*999)
2319  ELSE
2320  equations_set_setup_info%SETUP_TYPE=equations_set_setup_initial_type
2321  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
2322  !Finish the equations set specific setup
2323  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
2324  equations_set_setup_info%SETUP_TYPE=equations_set_setup_geometry_type
2325  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
2326  !Finish the equations set specific geometry setup
2327  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
2328  !Finalise the setup
2329  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
2330  !Finish the equations set creation
2331  equations_set%EQUATIONS_SET_FINISHED=.true.
2332  ENDIF
2333  ELSE
2334  CALL flagerror("Equations set is not associated.",err,error,*999)
2335  ENDIF
2336 
2337  exits("EQUATIONS_SET_CREATE_FINISH")
2338  RETURN
2339 999 errorsexits("EQUATIONS_SET_CREATE_FINISH",err,error)
2340  RETURN 1
2341 
2342  END SUBROUTINE equations_set_create_finish
2343 
2344  !
2345  !================================================================================================================================
2346  !
2347 
2360  SUBROUTINE equations_set_create_start(USER_NUMBER,REGION,GEOM_FIBRE_FIELD,EQUATIONS_SET_SPECIFICATION,&
2361  & equations_set_field_user_number,equations_set_field_field,equations_set,err,error,*)
2362 
2363  !Argument variables
2364  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
2365  TYPE(region_type), POINTER :: REGION
2366  TYPE(field_type), POINTER :: GEOM_FIBRE_FIELD
2367  INTEGER(INTG), INTENT(IN) :: EQUATIONS_SET_SPECIFICATION(:)
2368  INTEGER(INTG), INTENT(IN) :: EQUATIONS_SET_FIELD_USER_NUMBER
2369  TYPE(field_type), POINTER :: EQUATIONS_SET_FIELD_FIELD
2370  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2371  INTEGER(INTG), INTENT(OUT) :: ERR
2372  TYPE(varying_string), INTENT(OUT) :: ERROR
2373  !Local Variables
2374  INTEGER(INTG) :: DUMMY_ERR,equations_set_idx
2375  TYPE(equations_set_type), POINTER :: NEW_EQUATIONS_SET
2376  TYPE(equations_set_ptr_type), POINTER :: NEW_EQUATIONS_SETS(:)
2377  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
2378  TYPE(region_type), POINTER :: GEOM_FIBRE_FIELD_REGION,EQUATIONS_SET_FIELD_REGION
2379  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
2380  TYPE(equations_set_equations_set_field_type), POINTER :: EQUATIONS_EQUATIONS_SET_FIELD
2381  TYPE(field_type), POINTER :: FIELD
2382 
2383  NULLIFY(new_equations_set)
2384  NULLIFY(new_equations_sets)
2385  NULLIFY(equations_equations_set_field)
2386 
2387  enters("EQUATIONS_SET_CREATE_START",err,error,*997)
2388 
2389  IF(ASSOCIATED(region)) THEN
2390  IF(ASSOCIATED(region%EQUATIONS_SETS)) THEN
2391  CALL equations_set_user_number_find(user_number,region,new_equations_set,err,error,*997)
2392  IF(ASSOCIATED(new_equations_set)) THEN
2393  local_error="Equations set user number "//trim(number_to_vstring(user_number,"*",err,error))// &
2394  & " has already been created on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2395  CALL flagerror(local_error,err,error,*997)
2396  ELSE
2397  NULLIFY(new_equations_set)
2398  IF(ASSOCIATED(geom_fibre_field)) THEN
2399  IF(geom_fibre_field%FIELD_FINISHED) THEN
2400  IF(geom_fibre_field%TYPE==field_geometric_type.OR.geom_fibre_field%TYPE==field_fibre_type) THEN
2401  geom_fibre_field_region=>geom_fibre_field%REGION
2402  IF(ASSOCIATED(geom_fibre_field_region)) THEN
2403  IF(geom_fibre_field_region%USER_NUMBER==region%USER_NUMBER) THEN
2404  IF(ASSOCIATED(equations_set_field_field)) THEN
2405  !Check the equations set field has been finished
2406  IF(equations_set_field_field%FIELD_FINISHED.eqv..true.) THEN
2407  !Check the user numbers match
2408  IF(equations_set_field_user_number/=equations_set_field_field%USER_NUMBER) THEN
2409  local_error="The specified equations set field user number of "// &
2410  & trim(number_to_vstring(equations_set_field_user_number,"*",err,error))// &
2411  & " does not match the user number of the specified equations set field of "// &
2412  & trim(number_to_vstring(equations_set_field_field%USER_NUMBER,"*",err,error))//"."
2413  CALL flagerror(local_error,err,error,*999)
2414  ENDIF
2415  equations_set_field_region=>equations_set_field_field%REGION
2416  IF(ASSOCIATED(equations_set_field_region)) THEN
2417  !Check the field is defined on the same region as the equations set
2418  IF(equations_set_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
2419  local_error="Invalid region setup. The specified equations set field was created on region no. "// &
2420  & trim(number_to_vstring(equations_set_field_region%USER_NUMBER,"*",err,error))// &
2421  & " and the specified equations set has been created on region number "// &
2422  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2423  CALL flagerror(local_error,err,error,*999)
2424  ENDIF
2425  !Check the specified equations set field has the same decomposition as the geometric field
2426  IF(ASSOCIATED(geom_fibre_field)) THEN
2427  IF(.NOT.ASSOCIATED(geom_fibre_field%DECOMPOSITION,equations_set_field_field%DECOMPOSITION)) THEN
2428  CALL flagerror("The specified equations set field does not have the same decomposition "// &
2429  & "as the geometric field for the specified equations set.",err,error,*999)
2430  ENDIF
2431  ELSE
2432  CALL flagerror("The geom. field is not associated for the specified equations set.",err,error,*999)
2433  ENDIF
2434 
2435  ELSE
2436  CALL flagerror("The specified equations set field region is not associated.",err,error,*999)
2437  ENDIF
2438  ELSE
2439  CALL flagerror("The specified equations set field has not been finished.",err,error,*999)
2440  ENDIF
2441  ELSE
2442  !Check the user number has not already been used for a field in this region.
2443  NULLIFY(field)
2444  CALL field_user_number_find(equations_set_field_user_number,region,field,err,error,*999)
2445  IF(ASSOCIATED(field)) THEN
2446  local_error="The specified equations set field user number of "// &
2447  & trim(number_to_vstring(equations_set_field_user_number,"*",err,error))// &
2448  & "has already been used to create a field on region number "// &
2449  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2450  CALL flagerror(local_error,err,error,*999)
2451  ENDIF
2452  ENDIF
2453  !Initalise equations set
2454  CALL equations_set_initialise(new_equations_set,err,error,*999)
2455  !Set default equations set values
2456  new_equations_set%USER_NUMBER=user_number
2457  new_equations_set%GLOBAL_NUMBER=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1
2458  new_equations_set%EQUATIONS_SETS=>region%EQUATIONS_SETS
2459  new_equations_set%REGION=>region
2460  !Set the equations set class, type and subtype
2461  CALL equationsset_specificationset(new_equations_set,equations_set_specification,err,error,*999)
2462  new_equations_set%EQUATIONS_SET_FINISHED=.false.
2463  !Initialise the setup
2464  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
2465  equations_set_setup_info%SETUP_TYPE=equations_set_setup_initial_type
2466  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
2467  !Here, we get a pointer to the equations_set_field; default is null
2468  equations_set_setup_info%FIELD_USER_NUMBER=equations_set_field_user_number
2469  equations_set_setup_info%FIELD=>equations_set_field_field
2470  !Start equations set specific setup
2471  CALL equations_set_setup(new_equations_set,equations_set_setup_info,err,error,*999)
2472  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
2473  !Set up the equations set geometric fields
2474  CALL equations_set_geometry_initialise(new_equations_set,err,error,*999)
2475  IF(geom_fibre_field%TYPE==field_geometric_type) THEN
2476  new_equations_set%GEOMETRY%GEOMETRIC_FIELD=>geom_fibre_field
2477  NULLIFY(new_equations_set%GEOMETRY%FIBRE_FIELD)
2478  ELSE
2479  new_equations_set%GEOMETRY%GEOMETRIC_FIELD=>geom_fibre_field%GEOMETRIC_FIELD
2480  new_equations_set%GEOMETRY%FIBRE_FIELD=>geom_fibre_field
2481  ENDIF
2482  equations_set_setup_info%SETUP_TYPE=equations_set_setup_geometry_type
2483  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
2484  equations_set_setup_info%FIELD_USER_NUMBER=geom_fibre_field%USER_NUMBER
2485  equations_set_setup_info%FIELD=>geom_fibre_field
2486  !Set up equations set specific geometry
2487  CALL equations_set_setup(new_equations_set,equations_set_setup_info,err,error,*999)
2488  !Finalise the setup
2489  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
2490  !Add new equations set into list of equations set in the region
2491  ALLOCATE(new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1),stat=err)
2492  IF(err/=0) CALL flagerror("Could not allocate new equations sets.",err,error,*999)
2493  DO equations_set_idx=1,region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS
2494  new_equations_sets(equations_set_idx)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2495  ENDDO !equations_set_idx
2496  new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1)%PTR=>new_equations_set
2497  IF(ASSOCIATED(region%EQUATIONS_SETS%EQUATIONS_SETS)) DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2498  region%EQUATIONS_SETS%EQUATIONS_SETS=>new_equations_sets
2499  region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1
2500  equations_set=>new_equations_set
2501  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
2502  !\todo check pointer setup
2503  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
2504  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
2505  ELSE
2506  equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD=>equations_set_field_field
2507  ENDIF
2508  ELSE
2509  local_error="The geometric field region and the specified region do not match. "// &
2510  & "The geometric field was created on region number "// &
2511  & trim(number_to_vstring(geom_fibre_field_region%USER_NUMBER,"*",err,error))// &
2512  & " and the specified region number is "// &
2513  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2514  CALL flagerror(local_error,err,error,*997)
2515  ENDIF
2516  ELSE
2517  CALL flagerror("The specified geometric fields region is not associated.",err,error,*997)
2518  ENDIF
2519  ELSE
2520  CALL flagerror("The specified geometric field is not a geometric or fibre field.",err,error,*997)
2521  ENDIF
2522  ELSE
2523  CALL flagerror("The specified geometric field is not finished.",err,error,*997)
2524  ENDIF
2525  ELSE
2526  CALL flagerror("The specified geometric field is not associated.",err,error,*997)
2527  ENDIF
2528  ENDIF
2529  ELSE
2530  local_error="The equations sets on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))// &
2531  & " are not associated."
2532  CALL flagerror(local_error,err,error,*997)
2533  ENDIF
2534  ELSE
2535  CALL flagerror("Region is not associated.",err,error,*997)
2536  ENDIF
2537 
2538  exits("EQUATIONS_SET_CREATE_START")
2539  RETURN
2540 999 IF(ASSOCIATED(new_equations_set))CALL equations_set_finalise(new_equations_set,dummy_err,dummy_error,*998)
2541 998 IF(ASSOCIATED(new_equations_sets)) DEALLOCATE(new_equations_sets)
2542 997 errorsexits("EQUATIONS_SET_CREATE_START",err,error)
2543  RETURN 1
2544  END SUBROUTINE equations_set_create_start
2545 
2546  !
2547  !================================================================================================================================
2548  !
2549 
2551  SUBROUTINE equations_set_destroy_number(USER_NUMBER,REGION,ERR,ERROR,*)
2552 
2553  !Argument variables
2554  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
2555  TYPE(region_type), POINTER :: REGION
2556  INTEGER(INTG), INTENT(OUT) :: ERR
2557  TYPE(varying_string), INTENT(OUT) :: ERROR
2558  !Local Variables
2559  INTEGER(INTG) :: equations_set_idx,equations_set_position
2560  LOGICAL :: FOUND
2561  TYPE(varying_string) :: LOCAL_ERROR
2562  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2563  TYPE(equations_set_ptr_type), POINTER :: NEW_EQUATIONS_SETS(:)
2564 
2565  NULLIFY(new_equations_sets)
2566 
2567  enters("EQUATIONS_SET_DESTROY_NUMBER",err,error,*999)
2568 
2569  IF(ASSOCIATED(region)) THEN
2570  IF(ASSOCIATED(region%EQUATIONS_SETS)) THEN
2571 
2572  !Find the equations set identified by the user number
2573  found=.false.
2574  equations_set_position=0
2575  DO WHILE(equations_set_position<region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS.AND..NOT.found)
2576  equations_set_position=equations_set_position+1
2577  IF(region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_position)%PTR%USER_NUMBER==user_number)found=.true.
2578  ENDDO
2579 
2580  IF(found) THEN
2581 
2582  equations_set=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_position)%PTR
2583 
2584  !Destroy all the equations set components
2585  CALL equations_set_finalise(equations_set,err,error,*999)
2586 
2587  !Remove the equations set from the list of equations set
2588  IF(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS>1) THEN
2589  ALLOCATE(new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS-1),stat=err)
2590  IF(err/=0) CALL flagerror("Could not allocate new equations sets.",err,error,*999)
2591  DO equations_set_idx=1,region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS
2592  IF(equations_set_idx<equations_set_position) THEN
2593  new_equations_sets(equations_set_idx)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2594  ELSE IF(equations_set_idx>equations_set_position) THEN
2595  region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR%GLOBAL_NUMBER=region%EQUATIONS_SETS% &
2596  & equations_sets(equations_set_idx)%PTR%GLOBAL_NUMBER-1
2597  new_equations_sets(equations_set_idx-1)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2598  ENDIF
2599  ENDDO !equations_set_idx
2600  IF(ASSOCIATED(region%EQUATIONS_SETS%EQUATIONS_SETS)) DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2601  region%EQUATIONS_SETS%EQUATIONS_SETS=>new_equations_sets
2602  region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS-1
2603  ELSE
2604  DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2605  region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=0
2606  ENDIF
2607 
2608  ELSE
2609  local_error="Equations set number "//trim(number_to_vstring(user_number,"*",err,error))// &
2610  & " has not been created on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
2611  CALL flagerror(local_error,err,error,*999)
2612  ENDIF
2613  ELSE
2614  local_error="The equations sets on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))// &
2615  & " are not associated."
2616  CALL flagerror(local_error,err,error,*999)
2617  ENDIF
2618  ELSE
2619  CALL flagerror("Region is not associated.",err,error,*998)
2620  ENDIF
2621 
2622  exits("EQUATIONS_SET_DESTROY_NUMBER")
2623  RETURN
2624 999 IF(ASSOCIATED(new_equations_sets)) DEALLOCATE(new_equations_sets)
2625 998 errorsexits("EQUATIONS_SET_DESTROY_NUMBER",err,error)
2626  RETURN 1
2627  END SUBROUTINE equations_set_destroy_number
2628 
2629  !
2630  !================================================================================================================================
2631  !
2632 
2634  SUBROUTINE equations_set_destroy(EQUATIONS_SET,ERR,ERROR,*)
2635 
2636  !Argument variables
2637  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2638  INTEGER(INTG), INTENT(OUT) :: ERR
2639  TYPE(varying_string), INTENT(OUT) :: ERROR
2640  !Local Variables
2641  INTEGER(INTG) :: equations_set_idx,equations_set_position
2642  TYPE(equations_sets_type), POINTER :: EQUATIONS_SETS
2643  TYPE(equations_set_ptr_type), POINTER :: NEW_EQUATIONS_SETS(:)
2644 
2645  NULLIFY(new_equations_sets)
2646 
2647  enters("EQUATIONS_SET_DESTROY",err,error,*999)
2648 
2649  IF(ASSOCIATED(equations_set)) THEN
2650  equations_sets=>equations_set%EQUATIONS_SETS
2651  IF(ASSOCIATED(equations_sets)) THEN
2652  equations_set_position=equations_set%GLOBAL_NUMBER
2653 
2654  !Destroy all the equations set components
2655  CALL equations_set_finalise(equations_set,err,error,*999)
2656 
2657  !Remove the equations set from the list of equations set
2658  IF(equations_sets%NUMBER_OF_EQUATIONS_SETS>1) THEN
2659  ALLOCATE(new_equations_sets(equations_sets%NUMBER_OF_EQUATIONS_SETS-1),stat=err)
2660  IF(err/=0) CALL flagerror("Could not allocate new equations sets.",err,error,*999)
2661  DO equations_set_idx=1,equations_sets%NUMBER_OF_EQUATIONS_SETS
2662  IF(equations_set_idx<equations_set_position) THEN
2663  new_equations_sets(equations_set_idx)%PTR=>equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR
2664  ELSE IF(equations_set_idx>equations_set_position) THEN
2665  equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR%GLOBAL_NUMBER=equations_sets% &
2666  & equations_sets(equations_set_idx)%PTR%GLOBAL_NUMBER-1
2667  new_equations_sets(equations_set_idx-1)%PTR=>equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR
2668  ENDIF
2669  ENDDO !equations_set_idx
2670  IF(ASSOCIATED(equations_sets%EQUATIONS_SETS)) DEALLOCATE(equations_sets%EQUATIONS_SETS)
2671  equations_sets%EQUATIONS_SETS=>new_equations_sets
2672  equations_sets%NUMBER_OF_EQUATIONS_SETS=equations_sets%NUMBER_OF_EQUATIONS_SETS-1
2673  ELSE
2674  DEALLOCATE(equations_sets%EQUATIONS_SETS)
2675  equations_sets%NUMBER_OF_EQUATIONS_SETS=0
2676  ENDIF
2677 
2678  ELSE
2679  CALL flagerror("Equations set equations set is not associated.",err,error,*999)
2680  ENDIF
2681  ELSE
2682  CALL flagerror("Equations set is not associated.",err,error,*998)
2683  ENDIF
2684 
2685  exits("EQUATIONS_SET_DESTROY")
2686  RETURN
2687 999 IF(ASSOCIATED(new_equations_sets)) DEALLOCATE(new_equations_sets)
2688 998 errorsexits("EQUATIONS_SET_DESTROY",err,error)
2689  RETURN 1
2690 
2691  END SUBROUTINE equations_set_destroy
2692 
2693  !
2694  !================================================================================================================================
2695  !
2696 
2698  SUBROUTINE equations_set_finalise(EQUATIONS_SET,ERR,ERROR,*)
2699 
2700  !Argument variables
2701  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2702  INTEGER(INTG), INTENT(OUT) :: ERR
2703  TYPE(varying_string), INTENT(OUT) :: ERROR
2704  !Local Variables
2705 
2706  enters("EQUATIONS_SET_FINALISE",err,error,*999)
2707 
2708  IF(ASSOCIATED(equations_set)) THEN
2709  CALL equations_set_geometry_finalise(equations_set%GEOMETRY,err,error,*999)
2710  CALL equations_set_dependent_finalise(equations_set%DEPENDENT,err,error,*999)
2711  CALL equations_set_independent_finalise(equations_set%INDEPENDENT,err,error,*999)
2712  CALL equations_set_materials_finalise(equations_set%MATERIALS,err,error,*999)
2713  CALL equations_set_source_finalise(equations_set%SOURCE,err,error,*999)
2714  CALL equations_set_analytic_finalise(equations_set%ANALYTIC,err,error,*999)
2715  CALL equations_set_equations_set_field_finalise(equations_set%EQUATIONS_SET_FIELD,err,error,*999)
2716  CALL equationsset_derivedfinalise(equations_set%derived,err,error,*999)
2717  IF(ASSOCIATED(equations_set%EQUATIONS)) CALL equations_destroy(equations_set%EQUATIONS,err,error,*999)
2718  IF(ALLOCATED(equations_set%SPECIFICATION)) DEALLOCATE(equations_set%SPECIFICATION)
2719  DEALLOCATE(equations_set)
2720  ENDIF
2721 
2722  exits("EQUATIONS_SET_FINALISE")
2723  RETURN
2724 999 errorsexits("EQUATIONS_SET_FINALISE",err,error)
2725  RETURN 1
2726 
2727  END SUBROUTINE equations_set_finalise
2728 
2729  !
2730  !================================================================================================================================
2731  !
2732 
2734  SUBROUTINE equations_set_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2735 
2736  !Argument variables
2737  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2738  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2739  INTEGER(INTG), INTENT(OUT) :: ERR
2740  TYPE(varying_string), INTENT(OUT) :: ERROR
2741  !Local Variables
2742  INTEGER(INTG) :: matrix_idx
2743  TYPE(element_matrix_type), POINTER :: ELEMENT_MATRIX
2744  TYPE(element_vector_type), POINTER :: ELEMENT_VECTOR
2745  TYPE(equations_type), POINTER :: EQUATIONS
2746  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2747  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2748  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
2749  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2750  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
2751  TYPE(varying_string) :: LOCAL_ERROR
2752 
2753 #ifdef TAUPROF
2754  CALL tau_static_phase_start("EQUATIONS_SET_FINITE_ELEMENT_CALCULATE()")
2755 #endif
2756 
2757  enters("EQUATIONS_SET_FINITE_ELEMENT_CALCULATE",err,error,*999)
2758 
2759  IF(ASSOCIATED(equations_set)) THEN
2760  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2761  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2762  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
2763  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
2764  END IF
2765  SELECT CASE(equations_set%SPECIFICATION(1))
2766  CASE(equations_set_elasticity_class)
2767  CALL elasticity_finite_element_calculate(equations_set,element_number,err,error,*999)
2768  CASE(equations_set_fluid_mechanics_class)
2769  CALL fluid_mechanics_finite_element_calculate(equations_set,element_number,err,error,*999)
2770  CASE(equations_set_electromagnetics_class)
2771  CALL flagerror("Not implemented.",err,error,*999)
2772  CASE(equations_set_classical_field_class)
2773  CALL classical_field_finite_element_calculate(equations_set,element_number,err,error,*999)
2774  CASE(equations_set_fitting_class)
2775  CALL fitting_finite_element_calculate(equations_set,element_number,err,error,*999)
2776  CASE(equations_set_bioelectrics_class)
2777  IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
2778  CALL flagerror("Equations set specification must have at least two entries for a bioelectrics equation class.", &
2779  & err,error,*999)
2780  END IF
2781  IF(equations_set%SPECIFICATION(2) == equations_set_monodomain_strang_splitting_equation_type) THEN
2782  CALL monodomain_finiteelementcalculate(equations_set,element_number,err,error,*999)
2783  ELSE
2784  CALL bioelectric_finite_element_calculate(equations_set,element_number,err,error,*999)
2785  END IF
2786  CASE(equations_set_modal_class)
2787  CALL flagerror("Not implemented.",err,error,*999)
2788  CASE(equations_set_multi_physics_class)
2789  CALL multi_physics_finite_element_calculate(equations_set,element_number,err,error,*999)
2790  CASE DEFAULT
2791  local_error="The first equations set specification of "// &
2792  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
2793  CALL flagerror(local_error,err,error,*999)
2794  END SELECT
2795  equations=>equations_set%EQUATIONS
2796  IF(ASSOCIATED(equations)) THEN
2797  IF(equations%OUTPUT_TYPE>=equations_element_matrix_output) THEN
2798  equations_matrices=>equations%EQUATIONS_MATRICES
2799  IF(ASSOCIATED(equations_matrices)) THEN
2800  CALL write_string(general_output_type,"Finite element stiffness matrices:",err,error,*999)
2801  CALL write_string_value(general_output_type,"Element number = ",element_number,err,error,*999)
2802  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2803  IF(ASSOCIATED(dynamic_matrices)) THEN
2804  CALL write_string(general_output_type,"Dynamic matrices:",err,error,*999)
2805  CALL write_string_value(general_output_type,"Number of element matrices = ",dynamic_matrices% &
2806  & number_of_dynamic_matrices,err,error,*999)
2807  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2808  CALL write_string_value(general_output_type,"Element matrix : ",matrix_idx,err,error,*999)
2809  CALL write_string_value(general_output_type," Update matrix = ",dynamic_matrices%MATRICES(matrix_idx)%PTR% &
2810  & update_matrix,err,error,*999)
2811  IF(dynamic_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX) THEN
2812  element_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
2813  CALL write_string_value(general_output_type," Number of rows = ",element_matrix%NUMBER_OF_ROWS,err,error,*999)
2814  CALL write_string_value(general_output_type," Number of columns = ",element_matrix%NUMBER_OF_COLUMNS, &
2815  & err,error,*999)
2816  CALL write_string_value(general_output_type," Maximum number of rows = ",element_matrix%MAX_NUMBER_OF_ROWS, &
2817  & err,error,*999)
2818  CALL write_string_value(general_output_type," Maximum number of columns = ",element_matrix% &
2819  & max_number_of_columns,err,error,*999)
2820  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,8,8,element_matrix%ROW_DOFS, &
2821  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2822  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_COLUMNS,8,8,element_matrix% &
2823  & column_dofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2824  CALL write_string_matrix(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,1,1,element_matrix% &
2825  & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
2826  & number_of_columns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
2827  & '(16X,8(X,E13.6))',err,error,*999)
2828  ENDIF
2829  ENDDO !matrix_idx
2830  ENDIF
2831  linear_matrices=>equations_matrices%LINEAR_MATRICES
2832  IF(ASSOCIATED(linear_matrices)) THEN
2833  CALL write_string(general_output_type,"Linear matrices:",err,error,*999)
2834  CALL write_string_value(general_output_type,"Number of element matrices = ",linear_matrices% &
2835  & number_of_linear_matrices,err,error,*999)
2836  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2837  CALL write_string_value(general_output_type,"Element matrix : ",matrix_idx,err,error,*999)
2838  CALL write_string_value(general_output_type," Update matrix = ",linear_matrices%MATRICES(matrix_idx)%PTR% &
2839  & update_matrix,err,error,*999)
2840  IF(linear_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX) THEN
2841  element_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
2842  CALL write_string_value(general_output_type," Number of rows = ",element_matrix%NUMBER_OF_ROWS,err,error,*999)
2843  CALL write_string_value(general_output_type," Number of columns = ",element_matrix%NUMBER_OF_COLUMNS, &
2844  & err,error,*999)
2845  CALL write_string_value(general_output_type," Maximum number of rows = ",element_matrix%MAX_NUMBER_OF_ROWS, &
2846  & err,error,*999)
2847  CALL write_string_value(general_output_type," Maximum number of columns = ",element_matrix% &
2848  & max_number_of_columns,err,error,*999)
2849  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,8,8,element_matrix%ROW_DOFS, &
2850  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2851  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_COLUMNS,8,8,element_matrix% &
2852  & column_dofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2853  CALL write_string_matrix(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,1,1,element_matrix% &
2854  & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
2855  & number_of_columns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
2856  & '(16X,8(X,E13.6))',err,error,*999)
2857  ENDIF
2858  ENDDO !matrix_idx
2859  ENDIF
2860  rhs_vector=>equations_matrices%RHS_VECTOR
2861  IF(ASSOCIATED(rhs_vector)) THEN
2862  CALL write_string(general_output_type,"Element RHS vector :",err,error,*999)
2863  CALL write_string_value(general_output_type," Update vector = ",rhs_vector%UPDATE_VECTOR,err,error,*999)
2864  IF(rhs_vector%UPDATE_VECTOR) THEN
2865  element_vector=>rhs_vector%ELEMENT_VECTOR
2866  CALL write_string_value(general_output_type," Number of rows = ",element_vector%NUMBER_OF_ROWS,err,error,*999)
2867  CALL write_string_value(general_output_type," Maximum number of rows = ",element_vector%MAX_NUMBER_OF_ROWS, &
2868  & err,error,*999)
2869  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%ROW_DOFS, &
2870  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2871  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%VECTOR, &
2872  & '(" Vector(:):",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
2873  ENDIF
2874  ENDIF
2875  source_vector=>equations_matrices%SOURCE_VECTOR
2876  IF(ASSOCIATED(source_vector)) THEN
2877  CALL write_string(general_output_type,"Element source vector :",err,error,*999)
2878  CALL write_string_value(general_output_type," Update vector = ",source_vector%UPDATE_VECTOR,err,error,*999)
2879  IF(source_vector%UPDATE_VECTOR) THEN
2880  element_vector=>source_vector%ELEMENT_VECTOR
2881  CALL write_string_value(general_output_type," Number of rows = ",element_vector%NUMBER_OF_ROWS,err,error,*999)
2882  CALL write_string_value(general_output_type," Maximum number of rows = ",element_vector%MAX_NUMBER_OF_ROWS, &
2883  & err,error,*999)
2884  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%ROW_DOFS, &
2885  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
2886  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%VECTOR, &
2887  & '(" Vector(:):",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
2888  ENDIF
2889  ENDIF
2890  ELSE
2891  CALL flagerror("Equation matrices is not associated.",err,error,*999)
2892  ENDIF
2893  ENDIF
2894  ELSE
2895  CALL flagerror("Equations is not associated.",err,error,*999)
2896  ENDIF
2897  ELSE
2898  CALL flagerror("Equations set is not associated.",err,error,*999)
2899  ENDIF
2900 
2901 #ifdef TAUPROF
2902  CALL tau_static_phase_stop("EQUATIONS_SET_FINITE_ELEMENT_CALCULATE()")
2903 #endif
2904 
2905  exits("EQUATIONS_SET_FINITE_ELEMENT_CALCULATE")
2906  RETURN
2907 999 errorsexits("EQUATIONS_SET_FINITE_ELEMENT_CALCULATE",err,error)
2908  RETURN 1
2909 
2910  END SUBROUTINE equations_set_finite_element_calculate
2911 
2912  !
2913  !================================================================================================================================
2914  !
2915 
2917  SUBROUTINE equationsset_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2918 
2919  !Argument variables
2920  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2921  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2922  INTEGER(INTG), INTENT(OUT) :: ERR
2923  TYPE(varying_string), INTENT(OUT) :: ERROR
2924  !Local Variables
2925  INTEGER(INTG) :: matrix_idx
2926  TYPE(element_matrix_type), POINTER :: ELEMENT_MATRIX
2927  TYPE(equations_type), POINTER :: EQUATIONS
2928  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2929  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2930  TYPE(varying_string) :: LOCAL_ERROR
2931 
2932  enters("EquationsSet_FiniteElementJacobianEvaluate",err,error,*999)
2933 
2934  IF(ASSOCIATED(equations_set)) THEN
2935  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2936  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2937  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
2938  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
2939  END IF
2940  equations=>equations_set%EQUATIONS
2941  IF(ASSOCIATED(equations)) THEN
2942  equations_matrices=>equations%EQUATIONS_MATRICES
2943  IF(ASSOCIATED(equations_matrices)) THEN
2944  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2945  IF(ASSOCIATED(nonlinear_matrices)) THEN
2946  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2947  SELECT CASE(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%JACOBIAN_CALCULATION_TYPE)
2948  CASE(equations_jacobian_analytic_calculated)
2949  ! None of these routines currently support calculating off diagonal terms for coupled problems,
2950  ! but when one does we will have to pass through the matrix_idx parameter
2951  IF(matrix_idx>1) THEN
2952  CALL flagerror("Analytic off-diagonal Jacobian calculation not implemented.",err,error,*999)
2953  END IF
2954  SELECT CASE(equations_set%SPECIFICATION(1))
2955  CASE(equations_set_elasticity_class)
2956  CALL elasticity_finite_element_jacobian_evaluate(equations_set,element_number,err,error,*999)
2957  CASE(equations_set_fluid_mechanics_class)
2958  CALL fluidmechanics_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2959  CASE(equations_set_electromagnetics_class)
2960  CALL flagerror("Not implemented.",err,error,*999)
2961  CASE(equations_set_classical_field_class)
2962  CALL classicalfield_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2963  CASE(equations_set_bioelectrics_class)
2964  CALL flagerror("Not implemented.",err,error,*999)
2965  CASE(equations_set_modal_class)
2966  CALL flagerror("Not implemented.",err,error,*999)
2967  CASE(equations_set_multi_physics_class)
2968  CALL multiphysics_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2969  CASE DEFAULT
2970  local_error="The first equations set specification of"// &
2971  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*", &
2972  & err,error))//" is not valid."
2973  CALL flagerror(local_error,err,error,*999)
2974  END SELECT
2975  CASE(equations_jacobian_finite_difference_calculated)
2976  CALL equationsset_finiteelementjacobianevaluatefd(equations_set,element_number,matrix_idx,err,error,*999)
2977  CASE DEFAULT
2978  local_error="Jacobian calculation type "//trim(number_to_vstring(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR% &
2979  & jacobian_calculation_type,"*",err,error))//" is not valid."
2980  CALL flagerror(local_error,err,error,*999)
2981  END SELECT
2982  END DO
2983  ELSE
2984  CALL flagerror("Equations nonlinear matrices is not associated.",err,error,*999)
2985  END IF
2986  ELSE
2987  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2988  END IF
2989  IF(equations%OUTPUT_TYPE>=equations_element_matrix_output) THEN
2990  CALL write_string(general_output_type,"",err,error,*999)
2991  CALL write_string(general_output_type,"Finite element Jacobian matrix:",err,error,*999)
2992  CALL write_string_value(general_output_type,"Element number = ",element_number,err,error,*999)
2993  CALL write_string(general_output_type,"Element Jacobian:",err,error,*999)
2994  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2995  CALL write_string_value(general_output_type," Jacobian number = ",matrix_idx,err,error,*999)
2996  CALL write_string_value(general_output_type," Update Jacobian = ",nonlinear_matrices%JACOBIANS(matrix_idx)%PTR% &
2997  & update_jacobian,err,error,*999)
2998  IF(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%UPDATE_JACOBIAN) THEN
2999  element_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%ELEMENT_JACOBIAN
3000  CALL write_string_value(general_output_type," Number of rows = ",element_matrix%NUMBER_OF_ROWS,err,error,*999)
3001  CALL write_string_value(general_output_type," Number of columns = ",element_matrix%NUMBER_OF_COLUMNS, &
3002  & err,error,*999)
3003  CALL write_string_value(general_output_type," Maximum number of rows = ",element_matrix%MAX_NUMBER_OF_ROWS, &
3004  & err,error,*999)
3005  CALL write_string_value(general_output_type," Maximum number of columns = ",element_matrix% &
3006  & max_number_of_columns,err,error,*999)
3007  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,8,8,element_matrix%ROW_DOFS, &
3008  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3009  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_COLUMNS,8,8,element_matrix% &
3010  & column_dofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3011  CALL write_string_matrix(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,1,1,element_matrix% &
3012  & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3013  & number_of_columns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
3014  & '(16X,8(X,E13.6))',err,error,*999)
3015 !!TODO: Write out the element residual???
3016  END IF
3017  END DO
3018  END IF
3019  ELSE
3020  CALL flagerror("Equations is not associated.",err,error,*999)
3021  END IF
3022  ELSE
3023  CALL flagerror("Equations set is not associated.",err,error,*999)
3024  END IF
3025 
3026  exits("EquationsSet_FiniteElementJacobianEvaluate")
3027  RETURN
3028 999 errorsexits("EquationsSet_FiniteElementJacobianEvaluate",err,error)
3029  RETURN 1
3030 
3031  END SUBROUTINE equationsset_finiteelementjacobianevaluate
3032 
3033  !
3034  !================================================================================================================================
3035  !
3036 
3038  SUBROUTINE equationsset_finiteelementjacobianevaluatefd(equationsSet,elementNumber,jacobianNumber,err,error,*)
3039 
3040  !Argument variables
3041  TYPE(equations_set_type), POINTER :: equationsSet
3042  INTEGER(INTG), INTENT(IN) :: elementNumber
3043  INTEGER(INTG), INTENT(IN) :: jacobianNumber
3044  INTEGER(INTG), INTENT(OUT) :: err
3045  TYPE(varying_string), INTENT(OUT) :: error
3046  !Local Variables
3047  TYPE(equations_type), POINTER :: equations
3048  TYPE(equations_matrices_type), POINTER :: equationsMatrices
3049  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
3050  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
3051  TYPE(domain_elements_type), POINTER :: elementsTopology
3052  TYPE(basis_type), POINTER :: basis
3053  TYPE(distributed_vector_type), POINTER :: parameters
3054  TYPE(field_variable_type), POINTER :: rowVariable,columnVariable
3055  TYPE(element_vector_type) :: elementVector
3056  INTEGER(INTG) :: componentIdx,localNy,version,derivativeIdx,derivative,nodeIdx,node,column
3057  INTEGER(INTG) :: componentInterpolationType
3058  INTEGER(INTG) :: numberOfRows
3059  REAL(DP) :: delta,origDepVar
3060 
3061  enters("EquationsSet_FiniteElementJacobianEvaluateFD",err,error,*999)
3062 
3063  IF(ASSOCIATED(equationsset)) THEN
3064  equations=>equationsset%EQUATIONS
3065  IF(ASSOCIATED(equations)) THEN
3066  equationsmatrices=>equations%EQUATIONS_MATRICES
3067  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
3068  nonlinearmapping=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING
3069  ! The first residual variable is always the row variable, which is the variable the
3070  ! residual is calculated for
3071  rowvariable=>nonlinearmapping%RESIDUAL_VARIABLES(1)%PTR
3072  ! For coupled problems this routine will be called multiple times if multiple Jacobians use finite
3073  ! differencing, so make sure we only calculate the residual vector once, to save time and because
3074  ! it would otherwise add together
3075  IF(nonlinearmatrices%ELEMENT_RESIDUAL_CALCULATED/=elementnumber) THEN
3076  CALL equationsset_finiteelementresidualevaluate(equationsset,elementnumber,err,error,*999)
3077  END IF
3078  ! make a temporary copy of the unperturbed residuals
3079  elementvector=nonlinearmatrices%ELEMENT_RESIDUAL
3080  IF(jacobiannumber<=nonlinearmatrices%NUMBER_OF_JACOBIANS) THEN
3081  ! For coupled nonlinear problems there will be multiple Jacobians
3082  ! For this equations set, we calculate the residual for the row variable
3083  ! while pertubing parameters from the column variable.
3084  ! For non coupled problems these two variables will be the same
3085  columnvariable=>nonlinearmapping%RESIDUAL_VARIABLES(jacobiannumber)%PTR
3086  parameters=>columnvariable%PARAMETER_SETS%PARAMETER_SETS(field_values_set_type)%PTR%PARAMETERS ! vector of dependent variables, basically
3087  numberofrows=nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%NUMBER_OF_ROWS
3088  IF(numberofrows/=nonlinearmatrices%ELEMENT_RESIDUAL%NUMBER_OF_ROWS) THEN
3089  CALL flagerror("Element matrix number of rows does not match element residual vector size.",err,error,*999)
3090  END IF
3091  ! determine step size
3092  CALL distributedvector_l2norm(parameters,delta,err,error,*999)
3093  delta=(1.0_dp+delta)*1e-6
3094  ! the actual finite differencing algorithm is about 4 lines but since the parameters are all
3095  ! distributed out, have to use proper field accessing routines..
3096  ! so let's just loop over component, node/el, derivative
3097  column=0 ! element jacobian matrix column number
3098  DO componentidx=1,columnvariable%NUMBER_OF_COMPONENTS
3099  elementstopology=>columnvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%ELEMENTS
3100  componentinterpolationtype=columnvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE
3101  SELECT CASE (componentinterpolationtype)
3102  CASE (field_node_based_interpolation)
3103  basis=>elementstopology%ELEMENTS(elementnumber)%BASIS
3104  DO nodeidx=1,basis%NUMBER_OF_NODES
3105  node=elementstopology%ELEMENTS(elementnumber)%ELEMENT_NODES(nodeidx)
3106  DO derivativeidx=1,basis%NUMBER_OF_DERIVATIVES(nodeidx)
3107  derivative=elementstopology%ELEMENTS(elementnumber)%ELEMENT_DERIVATIVES(derivativeidx,nodeidx)
3108  version=elementstopology%ELEMENTS(elementnumber)%elementVersions(derivativeidx,nodeidx)
3109  localny=columnvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
3110  & derivatives(derivative)%VERSIONS(version)
3111  ! one-sided finite difference
3112  CALL distributed_vector_values_get(parameters,localny,origdepvar,err,error,*999)
3113  CALL distributed_vector_values_set(parameters,localny,origdepvar+delta,err,error,*999)
3114  nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp ! must remember to flush existing results, otherwise they're added
3115  CALL equationsset_finiteelementresidualevaluate(equationsset,elementnumber,err,error,*999)
3116  CALL distributed_vector_values_set(parameters,localny,origdepvar,err,error,*999)
3117  column=column+1
3118  nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%MATRIX(1:numberofrows,column)= &
3119  & (nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(1:numberofrows)-elementvector%VECTOR(1:numberofrows))/delta
3120  ENDDO !derivativeIdx
3121  ENDDO !nodeIdx
3122  CASE (field_element_based_interpolation)
3123  localny=columnvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP%ELEMENTS(elementnumber)
3124  ! one-sided finite difference
3125  CALL distributed_vector_values_get(parameters,localny,origdepvar,err,error,*999)
3126  CALL distributed_vector_values_set(parameters,localny,origdepvar+delta,err,error,*999)
3127  nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp ! must remember to flush existing results, otherwise they're added
3128  CALL equationsset_finiteelementresidualevaluate(equationsset,elementnumber,err,error,*999)
3129  CALL distributed_vector_values_set(parameters,localny,origdepvar,err,error,*999)
3130  column=column+1
3131  nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%MATRIX(1:numberofrows,column)= &
3132  & (nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(1:numberofrows)-elementvector%VECTOR(1:numberofrows))/delta
3133  CASE DEFAULT
3134  CALL flagerror("Unsupported type of interpolation.",err,error,*999)
3135  END SELECT
3136  END DO
3137  ! put the original residual back in
3138  nonlinearmatrices%ELEMENT_RESIDUAL=elementvector
3139  ELSE
3140  CALL flagerror("Invalid Jacobian number of "//trim(number_to_vstring(jacobiannumber,"*",err,error))// &
3141  & ". The number should be <= "//trim(number_to_vstring(nonlinearmatrices%NUMBER_OF_JACOBIANS,"*",err,error))// &
3142  & ".",err,error,*999)
3143  END IF
3144  ELSE
3145  CALL flagerror("Equations set equations is not associated.",err,error,*999)
3146  END IF
3147  ELSE
3148  CALL flagerror("Equations set is not associated.",err,error,*999)
3149  END IF
3150 
3151  exits("EquationsSet_FiniteElementJacobianEvaluateFD")
3152  RETURN
3153 999 errors("EquationsSet_FiniteElementJacobianEvaluateFD",err,error)
3154  exits("EquationsSet_FiniteElementJacobianEvaluateFD")
3155  RETURN 1
3156  END SUBROUTINE equationsset_finiteelementjacobianevaluatefd
3157 
3158  !
3159  !================================================================================================================================
3160  !
3161 
3163  SUBROUTINE equationsset_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
3164 
3165  !Argument variables
3166  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3167  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
3168  INTEGER(INTG), INTENT(OUT) :: ERR
3169  TYPE(varying_string), INTENT(OUT) :: ERROR
3170  !Local Variables
3171  INTEGER(INTG) :: matrix_idx
3172  TYPE(element_matrix_type), POINTER :: ELEMENT_MATRIX
3173  TYPE(element_vector_type), POINTER :: ELEMENT_VECTOR
3174  TYPE(equations_type), POINTER :: EQUATIONS
3175  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3176  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
3177  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3178  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3179  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
3180  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
3181  TYPE(varying_string) :: LOCAL_ERROR
3182 
3183  enters("EquationsSet_FiniteElementResidualEvaluate",err,error,*999)
3184 
3185  IF(ASSOCIATED(equations_set)) THEN
3186  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
3187  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
3188  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
3189  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
3190  END IF
3191  SELECT CASE(equations_set%SPECIFICATION(1))
3192  CASE(equations_set_elasticity_class)
3193  CALL elasticity_finite_element_residual_evaluate(equations_set,element_number,err,error,*999)
3194  CASE(equations_set_fluid_mechanics_class)
3195  CALL fluidmechanics_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3196  CASE(equations_set_electromagnetics_class)
3197  CALL flagerror("Not implemented.",err,error,*999)
3198  CASE(equations_set_classical_field_class)
3199  CALL classicalfield_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3200  CASE(equations_set_bioelectrics_class)
3201  CALL flagerror("Not implemented.",err,error,*999)
3202  CASE(equations_set_modal_class)
3203  CALL flagerror("Not implemented.",err,error,*999)
3204  CASE(equations_set_multi_physics_class)
3205  CALL multiphysics_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3206  CASE DEFAULT
3207  local_error="The first equations set specification of "// &
3208  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
3209  CALL flagerror(local_error,err,error,*999)
3210  END SELECT
3211  equations=>equations_set%EQUATIONS
3212  IF(ASSOCIATED(equations)) THEN
3213  equations_matrices=>equations%EQUATIONS_MATRICES
3214  IF(ASSOCIATED(equations_matrices)) THEN
3215  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3216  IF(ASSOCIATED(nonlinear_matrices)) THEN
3217  nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=element_number
3218  IF(equations%OUTPUT_TYPE>=equations_element_matrix_output) THEN
3219  CALL write_string(general_output_type,"",err,error,*999)
3220  CALL write_string(general_output_type,"Finite element residual matrices and vectors:",err,error,*999)
3221  CALL write_string_value(general_output_type,"Element number = ",element_number,err,error,*999)
3222  linear_matrices=>equations_matrices%LINEAR_MATRICES
3223  IF(ASSOCIATED(linear_matrices)) THEN
3224  CALL write_string(general_output_type,"Linear matrices:",err,error,*999)
3225  CALL write_string_value(general_output_type,"Number of element matrices = ",linear_matrices% &
3226  & number_of_linear_matrices,err,error,*999)
3227  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3228  CALL write_string_value(general_output_type,"Element matrix : ",matrix_idx,err,error,*999)
3229  CALL write_string_value(general_output_type," Update matrix = ",linear_matrices%MATRICES(matrix_idx)%PTR% &
3230  & update_matrix,err,error,*999)
3231  IF(linear_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX) THEN
3232  element_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
3233  CALL write_string_value(general_output_type," Number of rows = ",element_matrix%NUMBER_OF_ROWS,err,error,*999)
3234  CALL write_string_value(general_output_type," Number of columns = ",element_matrix%NUMBER_OF_COLUMNS, &
3235  & err,error,*999)
3236  CALL write_string_value(general_output_type," Maximum number of rows = ",element_matrix%MAX_NUMBER_OF_ROWS, &
3237  & err,error,*999)
3238  CALL write_string_value(general_output_type," Maximum number of columns = ",element_matrix% &
3239  & max_number_of_columns,err,error,*999)
3240  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,8,8,element_matrix%ROW_DOFS, &
3241  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3242  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_COLUMNS,8,8,element_matrix% &
3243  & column_dofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3244  CALL write_string_matrix(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,1,1,element_matrix% &
3245  & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3246  & number_of_columns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
3247  & '(16X,8(X,E13.6))',err,error,*999)
3248  ENDIF
3249  ENDDO !matrix_idx
3250  ENDIF
3251  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3252  IF(ASSOCIATED(dynamic_matrices)) THEN
3253  CALL write_string(general_output_type,"Dynamnic matrices:",err,error,*999)
3254  CALL write_string_value(general_output_type,"Number of element matrices = ",dynamic_matrices% &
3255  & number_of_dynamic_matrices,err,error,*999)
3256  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3257  CALL write_string_value(general_output_type,"Element matrix : ",matrix_idx,err,error,*999)
3258  CALL write_string_value(general_output_type," Update matrix = ",dynamic_matrices%MATRICES(matrix_idx)%PTR% &
3259  & update_matrix,err,error,*999)
3260  IF(dynamic_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX) THEN
3261  element_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
3262  CALL write_string_value(general_output_type," Number of rows = ",element_matrix%NUMBER_OF_ROWS,err,error,*999)
3263  CALL write_string_value(general_output_type," Number of columns = ",element_matrix%NUMBER_OF_COLUMNS, &
3264  & err,error,*999)
3265  CALL write_string_value(general_output_type," Maximum number of rows = ",element_matrix%MAX_NUMBER_OF_ROWS, &
3266  & err,error,*999)
3267  CALL write_string_value(general_output_type," Maximum number of columns = ",element_matrix% &
3268  & max_number_of_columns,err,error,*999)
3269  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,8,8,element_matrix%ROW_DOFS, &
3270  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3271  CALL write_string_vector(general_output_type,1,1,element_matrix%NUMBER_OF_COLUMNS,8,8,element_matrix% &
3272  & column_dofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3273  CALL write_string_matrix(general_output_type,1,1,element_matrix%NUMBER_OF_ROWS,1,1,element_matrix% &
3274  & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3275  & number_of_columns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
3276  & '(16X,8(X,E13.6))',err,error,*999)
3277  ENDIF
3278  ENDDO !matrix_idx
3279  ENDIF
3280  CALL write_string(general_output_type,"Element residual vector:",err,error,*999)
3281  CALL write_string_value(general_output_type," Update vector = ",nonlinear_matrices%UPDATE_RESIDUAL,err,error,*999)
3282  IF(nonlinear_matrices%UPDATE_RESIDUAL) THEN
3283  element_vector=>nonlinear_matrices%ELEMENT_RESIDUAL
3284  CALL write_string_value(general_output_type," Number of rows = ",element_vector%NUMBER_OF_ROWS,err,error,*999)
3285  CALL write_string_value(general_output_type," Maximum number of rows = ",element_vector%MAX_NUMBER_OF_ROWS, &
3286  & err,error,*999)
3287  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%ROW_DOFS, &
3288  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3289  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%VECTOR, &
3290  & '(" Vector(:):",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
3291  ENDIF
3292  rhs_vector=>equations_matrices%RHS_VECTOR
3293  IF(ASSOCIATED(rhs_vector)) THEN
3294  CALL write_string(general_output_type,"Element RHS vector :",err,error,*999)
3295  CALL write_string_value(general_output_type," Update vector = ",rhs_vector%UPDATE_VECTOR,err,error,*999)
3296  IF(rhs_vector%UPDATE_VECTOR) THEN
3297  element_vector=>rhs_vector%ELEMENT_VECTOR
3298  CALL write_string_value(general_output_type," Number of rows = ",element_vector%NUMBER_OF_ROWS,err,error,*999)
3299  CALL write_string_value(general_output_type," Maximum number of rows = ",element_vector%MAX_NUMBER_OF_ROWS, &
3300  & err,error,*999)
3301  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%ROW_DOFS, &
3302  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3303  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%VECTOR, &
3304  & '(" Vector(:) :",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
3305  ENDIF
3306  ENDIF
3307  source_vector=>equations_matrices%SOURCE_VECTOR
3308  IF(ASSOCIATED(source_vector)) THEN
3309  CALL write_string(general_output_type,"Element source vector :",err,error,*999)
3310  CALL write_string_value(general_output_type," Update vector = ",source_vector%UPDATE_VECTOR,err,error,*999)
3311  IF(source_vector%UPDATE_VECTOR) THEN
3312  element_vector=>source_vector%ELEMENT_VECTOR
3313  CALL write_string_value(general_output_type," Number of rows = ",element_vector%NUMBER_OF_ROWS,err,error,*999)
3314  CALL write_string_value(general_output_type," Maximum number of rows = ",element_vector%MAX_NUMBER_OF_ROWS, &
3315  & err,error,*999)
3316  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%ROW_DOFS, &
3317  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
3318  CALL write_string_vector(general_output_type,1,1,element_vector%NUMBER_OF_ROWS,8,8,element_vector%VECTOR, &
3319  & '(" Vector(:) :",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
3320  ENDIF
3321  ENDIF
3322  ENDIF
3323  ELSE
3324  CALL flagerror("Equation nonlinear matrices not associated.",err,error,*999)
3325  ENDIF
3326  ELSE
3327  CALL flagerror("Equation matrices is not associated.",err,error,*999)
3328  ENDIF
3329  ELSE
3330  CALL flagerror("Equations is not associated.",err,error,*999)
3331  ENDIF
3332  ELSE
3333  CALL flagerror("Equations set is not associated.",err,error,*999)
3334  ENDIF
3335 
3336  exits("EquationsSet_FiniteElementResidualEvaluate")
3337  RETURN
3338 999 errorsexits("EquationsSet_FiniteElementResidualEvaluate",err,error)
3339  RETURN 1
3340 
3341  END SUBROUTINE equationsset_finiteelementresidualevaluate
3342 
3343  !
3344  !================================================================================================================================
3345  !
3346 
3348  SUBROUTINE equations_set_independent_create_finish(EQUATIONS_SET,ERR,ERROR,*)
3349 
3350  !Argument variables
3351  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3352  INTEGER(INTG), INTENT(OUT) :: ERR
3353  TYPE(varying_string), INTENT(OUT) :: ERROR
3354  !Local Variables
3355  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
3356  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
3357 
3358  enters("EQUATIONS_SET_INDEPENDENT_CREATE_FINISH",err,error,*999)
3359 
3360  IF(ASSOCIATED(equations_set)) THEN
3361  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
3362  IF(equations_set%INDEPENDENT%INDEPENDENT_FINISHED) THEN
3363  CALL flagerror("Equations set independent field has already been finished.",err,error,*999)
3364  ELSE
3365  !Initialise the setup
3366  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
3367  equations_set_setup_info%SETUP_TYPE=equations_set_setup_independent_type
3368  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
3369  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
3370  IF(ASSOCIATED(independent_field)) THEN
3371  equations_set_setup_info%FIELD_USER_NUMBER=independent_field%USER_NUMBER
3372  equations_set_setup_info%FIELD=>independent_field
3373  !Finish equations set specific startup
3374  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
3375  ELSE
3376  CALL flagerror("Equations set independent independent field is not associated.",err,error,*999)
3377  ENDIF
3378  !Finalise the setup
3379  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
3380  !Finish independent creation
3381  equations_set%INDEPENDENT%INDEPENDENT_FINISHED=.true.
3382  ENDIF
3383  ELSE
3384  CALL flagerror("The equations set independent is not associated",err,error,*999)
3385  ENDIF
3386  ELSE
3387  CALL flagerror("Equations set is not associated",err,error,*999)
3388  ENDIF
3389 
3390  exits("EQUATIONS_SET_INDEPENDENT_CREATE_FINISH")
3391  RETURN
3392 999 errorsexits("EQUATIONS_SET_INDEPENDENT_CREATE_FINISH",err,error)
3393  RETURN 1
3394  END SUBROUTINE equations_set_independent_create_finish
3395 
3396  !
3397  !================================================================================================================================
3398  !
3399 
3401  SUBROUTINE equations_set_independent_create_start(EQUATIONS_SET,INDEPENDENT_FIELD_USER_NUMBER,INDEPENDENT_FIELD,ERR,ERROR,*)
3402 
3403  !Argument variables
3404  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3405  INTEGER(INTG), INTENT(IN) :: INDEPENDENT_FIELD_USER_NUMBER
3406  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
3407  INTEGER(INTG), INTENT(OUT) :: ERR
3408  TYPE(varying_string), INTENT(OUT) :: ERROR
3409  !Local Variables
3410  INTEGER(INTG) :: DUMMY_ERR
3411  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
3412  TYPE(field_type), POINTER :: FIELD,GEOMETRIC_FIELD
3413  TYPE(region_type), POINTER :: REGION,INDEPENDENT_FIELD_REGION
3414  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
3415 
3416  enters("EQUATIONS_SET_INDEPENDENT_CREATE_START",err,error,*998)
3417 
3418  IF(ASSOCIATED(equations_set)) THEN
3419  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
3420  CALL flagerror("The equations set independent is already associated",err,error,*998)
3421  ELSE
3422  region=>equations_set%REGION
3423  IF(ASSOCIATED(region)) THEN
3424  IF(ASSOCIATED(independent_field)) THEN
3425  !Check the independent field has been finished
3426  IF(independent_field%FIELD_FINISHED) THEN
3427  !Check the user numbers match
3428  IF(independent_field_user_number/=independent_field%USER_NUMBER) THEN
3429  local_error="The specified independent field user number of "// &
3430  & trim(number_to_vstring(independent_field_user_number,"*",err,error))// &
3431  & " does not match the user number of the specified independent field of "// &
3432  & trim(number_to_vstring(independent_field%USER_NUMBER,"*",err,error))//"."
3433  CALL flagerror(local_error,err,error,*999)
3434  ENDIF
3435  independent_field_region=>independent_field%REGION
3436  IF(ASSOCIATED(independent_field_region)) THEN
3437  !Check the field is defined on the same region as the equations set
3438  IF(independent_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
3439  local_error="Invalid region setup. The specified independent field has been created on region number "// &
3440  & trim(number_to_vstring(independent_field_region%USER_NUMBER,"*",err,error))// &
3441  & " and the specified equations set has been created on region number "// &
3442  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3443  CALL flagerror(local_error,err,error,*999)
3444  ENDIF
3445  !Check the specified independent field has the same decomposition as the geometric field
3446  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3447  IF(ASSOCIATED(geometric_field)) THEN
3448  IF(.NOT.ASSOCIATED(geometric_field%DECOMPOSITION,independent_field%DECOMPOSITION)) THEN
3449  CALL flagerror("The specified independent field does not have the same decomposition as the geometric "// &
3450  & "field for the specified equations set.",err,error,*999)
3451  ENDIF
3452  ELSE
3453  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
3454  ENDIF
3455  ELSE
3456  CALL flagerror("The specified independent field region is not associated.",err,error,*999)
3457  ENDIF
3458  ELSE
3459  CALL flagerror("The specified independent field has not been finished.",err,error,*999)
3460  ENDIF
3461  ELSE
3462  !Check the user number has not already been used for a field in this region.
3463  NULLIFY(field)
3464  CALL field_user_number_find(independent_field_user_number,region,field,err,error,*999)
3465  IF(ASSOCIATED(field)) THEN
3466  local_error="The specified independent field user number of "// &
3467  & trim(number_to_vstring(independent_field_user_number,"*",err,error))// &
3468  & "has already been used to create a field on region number "// &
3469  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3470  CALL flagerror(local_error,err,error,*999)
3471  ENDIF
3472  ENDIF
3473  !Initialise the equations set independent
3474  CALL equations_set_independent_initialise(equations_set,err,error,*999)
3475  IF(.NOT.ASSOCIATED(independent_field)) equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED=.true.
3476  !Initialise the setup
3477  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
3478  equations_set_setup_info%SETUP_TYPE=equations_set_setup_independent_type
3479  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
3480  equations_set_setup_info%FIELD_USER_NUMBER=independent_field_user_number
3481  equations_set_setup_info%FIELD=>independent_field
3482  !Start equations set specific startup
3483  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
3484  !Finalise the setup
3485  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
3486  !Set pointers
3487  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
3488  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
3489  ELSE
3490  equations_set%INDEPENDENT%INDEPENDENT_FIELD=>independent_field
3491  ENDIF
3492  ELSE
3493  CALL flagerror("Equation set region is not associated.",err,error,*999)
3494  ENDIF
3495  ENDIF
3496  ELSE
3497  CALL flagerror("Equations set is not associated",err,error,*998)
3498  ENDIF
3499 
3500  exits("EQUATIONS_SET_INDEPENDENT_CREATE_START")
3501  RETURN
3502 999 CALL equations_set_independent_finalise(equations_set%INDEPENDENT,dummy_err,dummy_error,*998)
3503 998 errorsexits("EQUATIONS_SET_INDEPENDENT_CREATE_START",err,error)
3504  RETURN 1
3505  END SUBROUTINE equations_set_independent_create_start
3506 
3507  !
3508  !================================================================================================================================
3509  !
3510 
3512  SUBROUTINE equations_set_independent_destroy(EQUATIONS_SET,ERR,ERROR,*)
3513 
3514  !Argument variables
3515  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3516  INTEGER(INTG), INTENT(OUT) :: ERR
3517  TYPE(varying_string), INTENT(OUT) :: ERROR
3518  !Local Variables
3519 
3520  enters("EQUATIONS_SET_INDEPENDENT_DESTROY",err,error,*999)
3521 
3522  IF(ASSOCIATED(equations_set)) THEN
3523  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
3524  CALL equations_set_independent_finalise(equations_set%INDEPENDENT,err,error,*999)
3525  ELSE
3526  CALL flagerror("Equations set indpendent is not associated.",err,error,*999)
3527  ENDIF
3528  ELSE
3529  CALL flagerror("Equations set is not associated.",err,error,*999)
3530  ENDIF
3531 
3532  exits("EQUATIONS_SET_INDEPENDENT_DESTROY")
3533  RETURN
3534 999 errorsexits("EQUATIONS_SET_INDEPENDENT_DESTROY",err,error)
3535  RETURN 1
3536  END SUBROUTINE equations_set_independent_destroy
3537 
3538  !
3539  !================================================================================================================================
3540  !
3541 
3543  SUBROUTINE equations_set_independent_finalise(EQUATIONS_SET_INDEPENDENT,ERR,ERROR,*)
3544 
3545  !Argument variables
3546  TYPE(equations_set_independent_type), POINTER :: EQUATIONS_SET_INDEPENDENT
3547  INTEGER(INTG), INTENT(OUT) :: ERR
3548  TYPE(varying_string), INTENT(OUT) :: ERROR
3549  !Local Variables
3550 
3551  enters("EQUATIONS_SET_INDEPENDENT_FINALISE",err,error,*999)
3552 
3553  IF(ASSOCIATED(equations_set_independent)) THEN
3554  DEALLOCATE(equations_set_independent)
3555  ENDIF
3556 
3557  exits("EQUATIONS_SET_INDEPENDENT_FINALISE")
3558  RETURN
3559 999 errorsexits("EQUATIONS_SET_INDEPENDENT_FINALISE",err,error)
3560  RETURN 1
3561  END SUBROUTINE equations_set_independent_finalise
3562 
3563  !
3564  !================================================================================================================================
3565  !
3566 
3568  SUBROUTINE equations_set_independent_initialise(EQUATIONS_SET,ERR,ERROR,*)
3569 
3570  !Argument variables
3571  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3572  INTEGER(INTG), INTENT(OUT) :: ERR
3573  TYPE(varying_string), INTENT(OUT) :: ERROR
3574  !Local Variables
3575  INTEGER(INTG) :: DUMMY_ERR
3576  TYPE(varying_string) :: DUMMY_ERROR
3577 
3578  enters("EQUATIONS_SET_INDEPENDENT_INITIALISE",err,error,*998)
3579 
3580  IF(ASSOCIATED(equations_set)) THEN
3581  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
3582  CALL flagerror("Independent field is already associated for these equations sets.",err,error,*998)
3583  ELSE
3584  ALLOCATE(equations_set%INDEPENDENT,stat=err)
3585  IF(err/=0) CALL flagerror("Could not allocate equations set independent field.",err,error,*999)
3586  equations_set%INDEPENDENT%EQUATIONS_SET=>equations_set
3587  equations_set%INDEPENDENT%INDEPENDENT_FINISHED=.false.
3588  equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED=.false.
3589  NULLIFY(equations_set%INDEPENDENT%INDEPENDENT_FIELD)
3590  ENDIF
3591  ELSE
3592  CALL flagerror("Equations set is not associated.",err,error,*998)
3593  ENDIF
3594 
3595  exits("EQUATIONS_SET_INDEPENDENT_INITIALISE")
3596  RETURN
3597 999 CALL equations_set_independent_finalise(equations_set%INDEPENDENT,dummy_err,dummy_error,*998)
3598 998 errorsexits("EQUATIONS_SET_INDEPENDENT_INITIALISE",err,error)
3599  RETURN 1
3600  END SUBROUTINE equations_set_independent_initialise
3601 
3602  !
3603  !================================================================================================================================
3604  !
3605 
3607  SUBROUTINE equations_set_initialise(EQUATIONS_SET,ERR,ERROR,*)
3608 
3609  !Argument variables
3610  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3611  INTEGER(INTG), INTENT(OUT) :: ERR
3612  TYPE(varying_string), INTENT(OUT) :: ERROR
3613  !Local Variables
3614  INTEGER(INTG) :: DUMMY_ERR
3615  TYPE(varying_string) :: DUMMY_ERROR
3616 
3617  enters("EQUATIONS_SET_INITIALISE",err,error,*998)
3618 
3619  IF(ASSOCIATED(equations_set)) THEN
3620  CALL flagerror("Equations set is already associated.",err,error,*998)
3621  ELSE
3622  ALLOCATE(equations_set,stat=err)
3623  IF(err/=0) CALL flagerror("Could not allocate equations set.",err,error,*999)
3624  equations_set%USER_NUMBER=0
3625  equations_set%GLOBAL_NUMBER=0
3626  equations_set%EQUATIONS_SET_FINISHED=.false.
3627  NULLIFY(equations_set%EQUATIONS_SETS)
3628  NULLIFY(equations_set%REGION)
3629  equations_set%SOLUTION_METHOD=0
3630  CALL equations_set_geometry_initialise(equations_set,err,error,*999)
3631  CALL equations_set_dependent_initialise(equations_set,err,error,*999)
3632  CALL equationsset_equationssetfieldinitialise(equations_set,err,error,*999)
3633  NULLIFY(equations_set%INDEPENDENT)
3634  NULLIFY(equations_set%MATERIALS)
3635  NULLIFY(equations_set%SOURCE)
3636  NULLIFY(equations_set%ANALYTIC)
3637  NULLIFY(equations_set%derived)
3638  NULLIFY(equations_set%EQUATIONS)
3639  NULLIFY(equations_set%BOUNDARY_CONDITIONS)
3640  ENDIF
3641 
3642  exits("EQUATIONS_SET_INITIALISE")
3643  RETURN
3644 999 CALL equations_set_finalise(equations_set,dummy_err,dummy_error,*998)
3645 998 errorsexits("EQUATIONS_SET_INITIALISE",err,error)
3646  RETURN 1
3647  END SUBROUTINE equations_set_initialise
3648 
3649  !
3650  !================================================================================================================================
3651  !
3652 
3654  SUBROUTINE equations_set_geometry_finalise(EQUATIONS_SET_GEOMETRY,ERR,ERROR,*)
3655 
3656  !Argument variables
3657  TYPE(equations_set_geometry_type) :: EQUATIONS_SET_GEOMETRY
3658  INTEGER(INTG), INTENT(OUT) :: ERR
3659  TYPE(varying_string), INTENT(OUT) :: ERROR
3660  !Local Variables
3661 
3662  enters("EQUATIONS_SET_GEOMETRY_FINALISE",err,error,*999)
3663 
3664  NULLIFY(equations_set_geometry%GEOMETRIC_FIELD)
3665  NULLIFY(equations_set_geometry%FIBRE_FIELD)
3666 
3667  exits("EQUATIONS_SET_GEOMETRY_FINALISE")
3668  RETURN
3669 999 errorsexits("EQUATIONS_SET_GEOMETRY_FINALISE",err,error)
3670  RETURN 1
3671  END SUBROUTINE equations_set_geometry_finalise
3672 
3673  !
3674  !================================================================================================================================
3675  !
3676 
3678  SUBROUTINE equations_set_geometry_initialise(EQUATIONS_SET,ERR,ERROR,*)
3679 
3680  !Argument variables
3681  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3682  INTEGER(INTG), INTENT(OUT) :: ERR
3683  TYPE(varying_string), INTENT(OUT) :: ERROR
3684  !Local Variables
3685 
3686  enters("EQUATIONS_SET_GEOMETRY_INITIALISE",err,error,*999)
3687 
3688  IF(ASSOCIATED(equations_set)) THEN
3689  equations_set%GEOMETRY%EQUATIONS_SET=>equations_set
3690  NULLIFY(equations_set%GEOMETRY%GEOMETRIC_FIELD)
3691  NULLIFY(equations_set%GEOMETRY%FIBRE_FIELD)
3692  ELSE
3693  CALL flagerror("Equations set is not associated.",err,error,*999)
3694  ENDIF
3695 
3696  exits("EQUATIONS_SET_GEOMETRY_INITIALISE")
3697  RETURN
3698 999 errorsexits("EQUATIONS_SET_GEOMETRY_INITIALISE",err,error)
3699  RETURN 1
3700  END SUBROUTINE equations_set_geometry_initialise
3701 
3702  !
3703  !================================================================================================================================
3704  !
3705 
3707  SUBROUTINE equations_set_materials_create_finish(EQUATIONS_SET,ERR,ERROR,*)
3708 
3709  !Argument variables
3710  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3711  INTEGER(INTG), INTENT(OUT) :: ERR
3712  TYPE(varying_string), INTENT(OUT) :: ERROR
3713  !Local Variables
3714  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
3715  TYPE(field_type), POINTER :: MATERIALS_FIELD
3716 
3717  enters("EQUATIONS_SET_MATERIALS_CREATE_FINISH",err,error,*999)
3718 
3719  IF(ASSOCIATED(equations_set)) THEN
3720  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
3721  IF(equations_set%MATERIALS%MATERIALS_FINISHED) THEN
3722  CALL flagerror("Equations set materials has already been finished.",err,error,*999)
3723  ELSE
3724  !Initialise the setup
3725  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
3726  equations_set_setup_info%SETUP_TYPE=equations_set_setup_materials_type
3727  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
3728  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
3729  IF(ASSOCIATED(materials_field)) THEN
3730  equations_set_setup_info%FIELD_USER_NUMBER=materials_field%USER_NUMBER
3731  equations_set_setup_info%FIELD=>materials_field
3732  !Finish equations set specific startup
3733  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
3734  ELSE
3735  CALL flagerror("Equations set materials materials field is not associated.",err,error,*999)
3736  ENDIF
3737  !Finalise the setup
3738  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
3739  !Finish materials creation
3740  equations_set%MATERIALS%MATERIALS_FINISHED=.true.
3741  ENDIF
3742  ELSE
3743  CALL flagerror("The equations set materials is not associated",err,error,*999)
3744  ENDIF
3745  ELSE
3746  CALL flagerror("Equations set is not associated",err,error,*999)
3747  ENDIF
3748 
3749  exits("EQUATIONS_SET_MATERIALS_CREATE_FINISH")
3750  RETURN
3751 999 errorsexits("EQUATIONS_SET_MATERIALS_CREATE_FINISH",err,error)
3752  RETURN 1
3753  END SUBROUTINE equations_set_materials_create_finish
3754 
3755  !
3756  !================================================================================================================================
3757  !
3758 
3760  SUBROUTINE equations_set_materials_create_start(EQUATIONS_SET,MATERIALS_FIELD_USER_NUMBER,MATERIALS_FIELD,ERR,ERROR,*)
3761 
3762  !Argument variables
3763  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3764  INTEGER(INTG), INTENT(IN) :: MATERIALS_FIELD_USER_NUMBER
3765  TYPE(field_type), POINTER :: MATERIALS_FIELD
3766  INTEGER(INTG), INTENT(OUT) :: ERR
3767  TYPE(varying_string), INTENT(OUT) :: ERROR
3768  !Local Variables
3769  INTEGER(INTG) :: DUMMY_ERR
3770  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
3771  TYPE(field_type), POINTER :: FIELD,GEOMETRIC_FIELD
3772  TYPE(region_type), POINTER :: REGION,MATERIALS_FIELD_REGION
3773  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
3774 
3775  enters("EQUATIONS_SET_MATERIALS_CREATE_START",err,error,*998)
3776 
3777  IF(ASSOCIATED(equations_set)) THEN
3778  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
3779  CALL flagerror("The equations set materials is already associated",err,error,*998)
3780  ELSE
3781  region=>equations_set%REGION
3782  IF(ASSOCIATED(region)) THEN
3783  IF(ASSOCIATED(materials_field)) THEN
3784  !Check the materials field has been finished
3785  IF(materials_field%FIELD_FINISHED) THEN
3786  !Check the user numbers match
3787  IF(materials_field_user_number/=materials_field%USER_NUMBER) THEN
3788  local_error="The specified materials field user number of "// &
3789  & trim(number_to_vstring(materials_field_user_number,"*",err,error))// &
3790  & " does not match the user number of the specified materials field of "// &
3791  & trim(number_to_vstring(materials_field%USER_NUMBER,"*",err,error))//"."
3792  CALL flagerror(local_error,err,error,*999)
3793  ENDIF
3794  materials_field_region=>materials_field%REGION
3795  IF(ASSOCIATED(materials_field_region)) THEN
3796  !Check the field is defined on the same region as the equations set
3797  IF(materials_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
3798  local_error="Invalid region setup. The specified materials field has been created on region number "// &
3799  & trim(number_to_vstring(materials_field_region%USER_NUMBER,"*",err,error))// &
3800  & " and the specified equations set has been created on region number "// &
3801  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3802  CALL flagerror(local_error,err,error,*999)
3803  ENDIF
3804  !Check the specified materials field has the same decomposition as the geometric field
3805  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3806  IF(ASSOCIATED(geometric_field)) THEN
3807  IF(.NOT.ASSOCIATED(geometric_field%DECOMPOSITION,materials_field%DECOMPOSITION)) THEN
3808  CALL flagerror("The specified materials field does not have the same decomposition as the geometric "// &
3809  & "field for the specified equations set.",err,error,*999)
3810  ENDIF
3811  ELSE
3812  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
3813  ENDIF
3814  ELSE
3815  CALL flagerror("The specified materials field region is not associated.",err,error,*999)
3816  ENDIF
3817  ELSE
3818  CALL flagerror("The specified materials field has not been finished.",err,error,*999)
3819  ENDIF
3820  ELSE
3821  !Check the user number has not already been used for a field in this region.
3822  NULLIFY(field)
3823  CALL field_user_number_find(materials_field_user_number,region,field,err,error,*999)
3824  IF(ASSOCIATED(field)) THEN
3825  local_error="The specified materials field user number of "// &
3826  & trim(number_to_vstring(materials_field_user_number,"*",err,error))// &
3827  & "has already been used to create a field on region number "// &
3828  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
3829  CALL flagerror(local_error,err,error,*999)
3830  ENDIF
3831  ENDIF
3832  !Initialise the equations set materials
3833  CALL equations_set_materials_initialise(equations_set,err,error,*999)
3834  IF(.NOT.ASSOCIATED(materials_field)) equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED=.true.
3835  !Initialise the setup
3836  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
3837  equations_set_setup_info%SETUP_TYPE=equations_set_setup_materials_type
3838  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
3839  equations_set_setup_info%FIELD_USER_NUMBER=materials_field_user_number
3840  equations_set_setup_info%FIELD=>materials_field
3841  !Start equations set specific startup
3842  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
3843  !Finalise the setup
3844  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
3845  !Set pointers
3846  IF(equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN
3847  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
3848  ELSE
3849  equations_set%MATERIALS%MATERIALS_FIELD=>materials_field
3850  ENDIF
3851  ELSE
3852  CALL flagerror("Equation set region is not associated.",err,error,*999)
3853  ENDIF
3854  ENDIF
3855  ELSE
3856  CALL flagerror("Equations set is not associated",err,error,*998)
3857  ENDIF
3858 
3859  exits("EQUATIONS_SET_MATERIALS_CREATE_START")
3860  RETURN
3861 999 CALL equations_set_materials_finalise(equations_set%MATERIALS,dummy_err,dummy_error,*998)
3862 998 errorsexits("EQUATIONS_SET_MATERIALS_CREATE_START",err,error)
3863  RETURN 1
3864  END SUBROUTINE equations_set_materials_create_start
3865 
3866  !
3867  !================================================================================================================================
3868  !
3869 
3871  SUBROUTINE equations_set_materials_destroy(EQUATIONS_SET,ERR,ERROR,*)
3872 
3873  !Argument variables
3874  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3875  INTEGER(INTG), INTENT(OUT) :: ERR
3876  TYPE(varying_string), INTENT(OUT) :: ERROR
3877  !Local Variables
3878 
3879  enters("EQUATIONS_SET_MATERIALS_DESTROY",err,error,*999)
3880 
3881  IF(ASSOCIATED(equations_set)) THEN
3882  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
3883  CALL equations_set_materials_finalise(equations_set%MATERIALS,err,error,*999)
3884  ELSE
3885  CALL flagerror("Equations set materials is not associated.",err,error,*999)
3886  ENDIF
3887  ELSE
3888  CALL flagerror("Equations set is not associated.",err,error,*999)
3889  ENDIF
3890 
3891  exits("EQUATIONS_SET_MATERIALS_DESTROY")
3892  RETURN
3893 999 errorsexits("EQUATIONS_SET_MATERIALS_DESTROY",err,error)
3894  RETURN 1
3895  END SUBROUTINE equations_set_materials_destroy
3896 
3897  !
3898  !================================================================================================================================
3899  !
3900 
3902  SUBROUTINE equations_set_materials_finalise(EQUATIONS_SET_MATERIALS,ERR,ERROR,*)
3903 
3904  !Argument variables
3905  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_SET_MATERIALS
3906  INTEGER(INTG), INTENT(OUT) :: ERR
3907  TYPE(varying_string), INTENT(OUT) :: ERROR
3908  !Local Variables
3909 
3910  enters("EQUATIONS_SET_MATERIALS_FINALISE",err,error,*999)
3911 
3912  IF(ASSOCIATED(equations_set_materials)) THEN
3913  DEALLOCATE(equations_set_materials)
3914  ENDIF
3915 
3916  exits("EQUATIONS_SET_MATERIALS_FINALISE")
3917  RETURN
3918 999 errorsexits("EQUATIONS_SET_MATERIALS_FINALISE",err,error)
3919  RETURN 1
3920  END SUBROUTINE equations_set_materials_finalise
3921 
3922  !
3923  !================================================================================================================================
3924  !
3925 
3927  SUBROUTINE equations_set_materials_initialise(EQUATIONS_SET,ERR,ERROR,*)
3928 
3929  !Argument variables
3930  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3931  INTEGER(INTG), INTENT(OUT) :: ERR
3932  TYPE(varying_string), INTENT(OUT) :: ERROR
3933  !Local Variables
3934  INTEGER(INTG) :: DUMMY_ERR
3935  TYPE(varying_string) :: DUMMY_ERROR
3936 
3937  enters("EQUATIONS_SET_MATERIALS_INITIALISE",err,error,*998)
3938 
3939  IF(ASSOCIATED(equations_set)) THEN
3940  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
3941  CALL flagerror("Materials is already associated for these equations sets.",err,error,*998)
3942  ELSE
3943  ALLOCATE(equations_set%MATERIALS,stat=err)
3944  IF(err/=0) CALL flagerror("Could not allocate equations set materials.",err,error,*999)
3945  equations_set%MATERIALS%EQUATIONS_SET=>equations_set
3946  equations_set%MATERIALS%MATERIALS_FINISHED=.false.
3947  equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED=.false.
3948  NULLIFY(equations_set%MATERIALS%MATERIALS_FIELD)
3949  ENDIF
3950  ELSE
3951  CALL flagerror("Equations set is not associated",err,error,*998)
3952  ENDIF
3953 
3954  exits("EQUATIONS_SET_MATERIALS_INITIALISE")
3955  RETURN
3956 999 CALL equations_set_materials_finalise(equations_set%MATERIALS,dummy_err,dummy_error,*998)
3957 998 errorsexits("EQUATIONS_SET_MATERIALS_INITIALISE",err,error)
3958  RETURN 1
3959  END SUBROUTINE equations_set_materials_initialise
3960 
3961  !
3962  !
3963  !================================================================================================================================
3964  !
3965 
3967  SUBROUTINE equations_set_dependent_create_finish(EQUATIONS_SET,ERR,ERROR,*)
3968 
3969  !Argument variables
3970  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3971  INTEGER(INTG), INTENT(OUT) :: ERR
3972  TYPE(varying_string), INTENT(OUT) :: ERROR
3973  !Local Variables
3974  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
3975  TYPE(field_type), POINTER :: DEPENDENT_FIELD
3976 
3977  enters("EQUATIONS_SET_DEPENDENT_CREATE_FINISH",err,error,*999)
3978 
3979  IF(ASSOCIATED(equations_set)) THEN
3980  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
3981  CALL flagerror("Equations set dependent has already been finished",err,error,*999)
3982  ELSE
3983  !Initialise the setup
3984  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
3985  equations_set_setup_info%SETUP_TYPE=equations_set_setup_dependent_type
3986  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
3987  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
3988  IF(ASSOCIATED(dependent_field)) THEN
3989  equations_set_setup_info%FIELD_USER_NUMBER=dependent_field%USER_NUMBER
3990  equations_set_setup_info%FIELD=>dependent_field
3991  !Finish equations set specific setup
3992  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
3993  ELSE
3994  CALL flagerror("Equations set dependent dependent field is not associated.",err,error,*999)
3995  ENDIF
3996  !Finalise the setup
3997  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
3998  !Finish the equations set creation
3999  equations_set%DEPENDENT%DEPENDENT_FINISHED=.true.
4000  ENDIF
4001  ELSE
4002  CALL flagerror("Equations set is not associated",err,error,*999)
4003  ENDIF
4004 
4005  exits("EQUATIONS_SET_DEPENDENT_CREATE_FINISH")
4006  RETURN
4007 999 errorsexits("EQUATIONS_SET_DEPENDENT_CREATE_FINISH",err,error)
4008  RETURN 1
4009  END SUBROUTINE equations_set_dependent_create_finish
4010 
4011  !
4012  !================================================================================================================================
4013  !
4014 
4016  SUBROUTINE equations_set_dependent_create_start(EQUATIONS_SET,DEPENDENT_FIELD_USER_NUMBER,DEPENDENT_FIELD,ERR,ERROR,*)
4017 
4018  !Argument variables
4019  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4020  INTEGER(INTG), INTENT(IN) :: DEPENDENT_FIELD_USER_NUMBER
4021  TYPE(field_type), POINTER :: DEPENDENT_FIELD
4022  INTEGER(INTG), INTENT(OUT) :: ERR
4023  TYPE(varying_string), INTENT(OUT) :: ERROR
4024  !Local Variables
4025  INTEGER(INTG) :: DUMMY_ERR
4026  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
4027  TYPE(field_type), POINTER :: FIELD,GEOMETRIC_FIELD
4028  TYPE(region_type), POINTER :: REGION,DEPENDENT_FIELD_REGION
4029  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
4030 
4031  enters("EQUATIONS_SET_DEPENDENT_CREATE_START",err,error,*998)
4032 
4033  IF(ASSOCIATED(equations_set)) THEN
4034  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
4035  CALL flagerror("The equations set dependent has been finished.",err,error,*999)
4036  ELSE
4037  region=>equations_set%REGION
4038  IF(ASSOCIATED(region)) THEN
4039  IF(ASSOCIATED(dependent_field)) THEN
4040  !Check the dependent field has been finished
4041  IF(dependent_field%FIELD_FINISHED) THEN
4042  !Check the user numbers match
4043  IF(dependent_field_user_number/=dependent_field%USER_NUMBER) THEN
4044  local_error="The specified dependent field user number of "// &
4045  & trim(number_to_vstring(dependent_field_user_number,"*",err,error))// &
4046  & " does not match the user number of the specified dependent field of "// &
4047  & trim(number_to_vstring(dependent_field%USER_NUMBER,"*",err,error))//"."
4048  CALL flagerror(local_error,err,error,*999)
4049  ENDIF
4050  dependent_field_region=>dependent_field%REGION
4051  IF(ASSOCIATED(dependent_field_region)) THEN
4052  !Check the field is defined on the same region as the equations set
4053  IF(dependent_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
4054  local_error="Invalid region setup. The specified dependent field has been created on region number "// &
4055  & trim(number_to_vstring(dependent_field_region%USER_NUMBER,"*",err,error))// &
4056  & " and the specified equations set has been created on region number "// &
4057  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
4058  CALL flagerror(local_error,err,error,*999)
4059  ENDIF
4060  !Check the specified dependent field has the same decomposition as the geometric field
4061  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
4062  IF(ASSOCIATED(geometric_field)) THEN
4063  IF(.NOT.ASSOCIATED(geometric_field%DECOMPOSITION,dependent_field%DECOMPOSITION)) THEN
4064  CALL flagerror("The specified dependent field does not have the same decomposition as the geometric "// &
4065  & "field for the specified equations set.",err,error,*999)
4066  ENDIF
4067  ELSE
4068  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
4069  ENDIF
4070  ELSE
4071  CALL flagerror("The specified dependent field region is not associated.",err,error,*999)
4072  ENDIF
4073  ELSE
4074  CALL flagerror("The specified dependent field has not been finished.",err,error,*999)
4075  ENDIF
4076  ELSE
4077  !Check the user number has not already been used for a field in this region.
4078  NULLIFY(field)
4079  CALL field_user_number_find(dependent_field_user_number,region,field,err,error,*999)
4080  IF(ASSOCIATED(field)) THEN
4081  local_error="The specified dependent field user number of "// &
4082  & trim(number_to_vstring(dependent_field_user_number,"*",err,error))// &
4083  & " has already been used to create a field on region number "// &
4084  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
4085  CALL flagerror(local_error,err,error,*999)
4086  ENDIF
4087  equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED=.true.
4088  ENDIF
4089  !Initialise the setup
4090  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
4091  equations_set_setup_info%SETUP_TYPE=equations_set_setup_dependent_type
4092  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
4093  equations_set_setup_info%FIELD_USER_NUMBER=dependent_field_user_number
4094  equations_set_setup_info%FIELD=>dependent_field
4095  !Start the equations set specfic solution setup
4096  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4097  !Finalise the setup
4098  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
4099  !Set pointers
4100  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
4101  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4102  ELSE
4103  equations_set%DEPENDENT%DEPENDENT_FIELD=>dependent_field
4104  ENDIF
4105  ELSE
4106  CALL flagerror("Equation set region is not associated.",err,error,*999)
4107  ENDIF
4108  ENDIF
4109  ELSE
4110  CALL flagerror("Equations_set is not associated.",err,error,*998)
4111  ENDIF
4112 
4113  exits("EQUATIONS_SET_DEPENDENT_CREATE_START")
4114  RETURN
4115 999 CALL equations_set_dependent_finalise(equations_set%DEPENDENT,dummy_err,dummy_error,*998)
4116 998 errorsexits("EQUATIONS_SET_DEPENDENT_CREATE_START",err,error)
4117  RETURN 1
4118  END SUBROUTINE equations_set_dependent_create_start
4119 
4120  !
4121  !================================================================================================================================
4122  !
4123 
4125  SUBROUTINE equations_set_dependent_destroy(EQUATIONS_SET,ERR,ERROR,*)
4126 
4127  !Argument variables
4128  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4129  INTEGER(INTG), INTENT(OUT) :: ERR
4130  TYPE(varying_string), INTENT(OUT) :: ERROR
4131  !Local Variables
4132 
4133  enters("EQUATIONS_SET_DEPENDENT_DESTROY",err,error,*999)
4134 
4135  IF(ASSOCIATED(equations_set)) THEN
4136  CALL equations_set_dependent_finalise(equations_set%DEPENDENT,err,error,*999)
4137  ELSE
4138  CALL flagerror("Equations set is not associated",err,error,*999)
4139  ENDIF
4140 
4141  exits("EQUATIONS_SET_DEPENDENT_DESTROY")
4142  RETURN
4143 999 errorsexits("EQUATIONS_SET_DEPENDENT_DESTROY",err,error)
4144  RETURN 1
4145  END SUBROUTINE equations_set_dependent_destroy
4146 
4147  !
4148  !================================================================================================================================
4149  !
4150 
4152  SUBROUTINE equations_set_dependent_finalise(EQUATIONS_SET_DEPENDENT,ERR,ERROR,*)
4153 
4154  !Argument variables
4155  TYPE(equations_set_dependent_type) :: EQUATIONS_SET_DEPENDENT
4156  INTEGER(INTG), INTENT(OUT) :: ERR
4157  TYPE(varying_string), INTENT(OUT) :: ERROR
4158  !Local Variables
4159 
4160  enters("EQUATIONS_SET_DEPENDENT_FINALISE",err,error,*999)
4161 
4162  NULLIFY(equations_set_dependent%EQUATIONS_SET)
4163  equations_set_dependent%DEPENDENT_FINISHED=.false.
4164  equations_set_dependent%DEPENDENT_FIELD_AUTO_CREATED=.false.
4165  NULLIFY(equations_set_dependent%DEPENDENT_FIELD)
4166 
4167  exits("EQUATIONS_SET_DEPENDENT_FINALISE")
4168  RETURN
4169 999 errorsexits("EQUATIONS_SET_DEPENDENT_FINALISE",err,error)
4170  RETURN 1
4171  END SUBROUTINE equations_set_dependent_finalise
4172 
4173  !
4174  !================================================================================================================================
4175  !
4176 
4178  SUBROUTINE equations_set_dependent_initialise(EQUATIONS_SET,ERR,ERROR,*)
4179 
4180  !Argument variables
4181  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4182  INTEGER(INTG), INTENT(OUT) :: ERR
4183  TYPE(varying_string), INTENT(OUT) :: ERROR
4184  !Local Variables
4185 
4186  enters("EQUATIONS_SET_DEPENDENT_INITIALISE",err,error,*999)
4187 
4188  IF(ASSOCIATED(equations_set)) THEN
4189  equations_set%DEPENDENT%EQUATIONS_SET=>equations_set
4190  equations_set%DEPENDENT%DEPENDENT_FINISHED=.false.
4191  equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED=.false.
4192  NULLIFY(equations_set%DEPENDENT%DEPENDENT_FIELD)
4193  ELSE
4194  CALL flagerror("Equations set is not associated.",err,error,*999)
4195  ENDIF
4196 
4197  exits("EQUATIONS_SET_DEPENDENT_INITIALISE")
4198  RETURN
4199 999 errorsexits("EQUATIONS_SET_DEPENDENT_INITIALISE",err,error)
4200  RETURN 1
4201  END SUBROUTINE equations_set_dependent_initialise
4202 
4203  !
4204  !================================================================================================================================
4205  !
4206 
4208  SUBROUTINE equationsset_derivedcreatefinish(equationsSet,err,error,*)
4209 
4210  !Argument variables
4211  TYPE(equations_set_type), POINTER :: equationsSet
4212  INTEGER(INTG), INTENT(OUT) :: err
4213  TYPE(varying_string), INTENT(OUT) :: error
4214  !Local Variables
4215  TYPE(equations_set_setup_type) :: equationsSetSetupInfo
4216  TYPE(field_type), POINTER :: derivedField
4217 
4218  enters("EquationsSet_DerivedCreateFinish",err,error,*999)
4219 
4220  IF(ASSOCIATED(equationsset)) THEN
4221  IF(ASSOCIATED(equationsset%derived)) THEN
4222  IF(equationsset%derived%derivedFinished) THEN
4223  CALL flagerror("Equations set derived field information has already been finished",err,error,*999)
4224  ELSE
4225  !Initialise the setup
4226  CALL equations_set_setup_initialise(equationssetsetupinfo,err,error,*999)
4227  equationssetsetupinfo%SETUP_TYPE=equations_set_setup_derived_type
4228  equationssetsetupinfo%ACTION_TYPE=equations_set_setup_finish_action
4229  derivedfield=>equationsset%derived%derivedField
4230  IF(ASSOCIATED(derivedfield)) THEN
4231  equationssetsetupinfo%FIELD_USER_NUMBER=derivedfield%USER_NUMBER
4232  equationssetsetupinfo%field=>derivedfield
4233  !Finish equations set specific setup
4234  CALL equations_set_setup(equationsset,equationssetsetupinfo,err,error,*999)
4235  ELSE
4236  CALL flagerror("Equations set derived field is not associated.",err,error,*999)
4237  END IF
4238  !Finalise the setup
4239  CALL equations_set_setup_finalise(equationssetsetupinfo,err,error,*999)
4240  !Finish the equations set derived creation
4241  equationsset%derived%derivedFinished=.true.
4242  END IF
4243  ELSE
4244  CALL flagerror("Equations set derived is not associated",err,error,*999)
4245  END IF
4246  ELSE
4247  CALL flagerror("Equations set is not associated",err,error,*999)
4248  END IF
4249 
4250  exits("EquationsSet_DerivedCreateFinish")
4251  RETURN
4252 999 errorsexits("EquationsSet_DerivedCreateFinish",err,error)
4253  RETURN 1
4254  END SUBROUTINE equationsset_derivedcreatefinish
4255 
4256  !
4257  !================================================================================================================================
4258  !
4259 
4261  SUBROUTINE equationsset_derivedcreatestart(equationsSet,derivedFieldUserNumber,derivedField,err,error,*)
4262 
4263  !Argument variables
4264  TYPE(equations_set_type), POINTER :: equationsSet
4265  INTEGER(INTG), INTENT(IN) :: derivedFieldUserNumber
4266  TYPE(field_type), POINTER :: derivedField
4267  INTEGER(INTG), INTENT(OUT) :: err
4268  TYPE(varying_string), INTENT(OUT) :: error
4269  !Local Variables
4270  INTEGER(INTG) :: dummyErr
4271  TYPE(equations_set_setup_type) :: equationsSetSetupInfo
4272  TYPE(field_type), POINTER :: field,geometricField
4273  TYPE(region_type), POINTER :: region,derivedFieldRegion
4274  TYPE(varying_string) :: dummyError,localError
4275 
4276  enters("EquationsSet_DerivedCreateStart",err,error,*998)
4277 
4278  IF(ASSOCIATED(equationsset)) THEN
4279  IF(ASSOCIATED(equationsset%derived)) THEN
4280  CALL flagerror("Equations set derived is already associated.",err,error,*998)
4281  ELSE
4282  region=>equationsset%REGION
4283  IF(ASSOCIATED(region)) THEN
4284  IF(ASSOCIATED(derivedfield)) THEN
4285  !Check the derived field has been finished
4286  IF(derivedfield%FIELD_FINISHED) THEN
4287  !Check the user numbers match
4288  IF(derivedfieldusernumber/=derivedfield%USER_NUMBER) THEN
4289  localerror="The specified derived field user number of "// &
4290  & trim(number_to_vstring(derivedfieldusernumber,"*",err,error))// &
4291  & " does not match the user number of the specified derived field of "// &
4292  & trim(number_to_vstring(derivedfield%USER_NUMBER,"*",err,error))//"."
4293  CALL flagerror(localerror,err,error,*999)
4294  END IF
4295  derivedfieldregion=>derivedfield%REGION
4296  IF(ASSOCIATED(derivedfieldregion)) THEN
4297  !Check the field is defined on the same region as the equations set
4298  IF(derivedfieldregion%USER_NUMBER/=region%USER_NUMBER) THEN
4299  localerror="Invalid region setup. The specified derived field has been created on region number "// &
4300  & trim(number_to_vstring(derivedfieldregion%USER_NUMBER,"*",err,error))// &
4301  & " and the specified equations set has been created on region number "// &
4302  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
4303  CALL flagerror(localerror,err,error,*999)
4304  END IF
4305  !Check the specified derived field has the same decomposition as the geometric field
4306  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
4307  IF(ASSOCIATED(geometricfield)) THEN
4308  IF(.NOT.ASSOCIATED(geometricfield%DECOMPOSITION,derivedfield%DECOMPOSITION)) THEN
4309  CALL flagerror("The specified derived field does not have the same decomposition as the geometric "// &
4310  & "field for the specified equations set.",err,error,*999)
4311  END IF
4312  ELSE
4313  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
4314  END IF
4315  ELSE
4316  CALL flagerror("The specified derived field region is not associated.",err,error,*999)
4317  END IF
4318  ELSE
4319  CALL flagerror("The specified derived field has not been finished.",err,error,*999)
4320  END IF
4321  ELSE
4322  !Check the user number has not already been used for a field in this region.
4323  NULLIFY(field)
4324  CALL field_user_number_find(derivedfieldusernumber,region,field,err,error,*999)
4325  IF(ASSOCIATED(field)) THEN
4326  localerror="The specified derived field user number of "// &
4327  & trim(number_to_vstring(derivedfieldusernumber,"*",err,error))// &
4328  & " has already been used to create a field on region number "// &
4329  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
4330  CALL flagerror(localerror,err,error,*999)
4331  END IF
4332  equationsset%derived%derivedFieldAutoCreated=.true.
4333  END IF
4334  CALL equationsset_derivedinitialise(equationsset,err,error,*999)
4335  !Initialise the setup
4336  CALL equations_set_setup_initialise(equationssetsetupinfo,err,error,*999)
4337  equationssetsetupinfo%SETUP_TYPE=equations_set_setup_derived_type
4338  equationssetsetupinfo%ACTION_TYPE=equations_set_setup_start_action
4339  equationssetsetupinfo%FIELD_USER_NUMBER=derivedfieldusernumber
4340  equationssetsetupinfo%FIELD=>derivedfield
4341  !Start the equations set specfic solution setup
4342  CALL equations_set_setup(equationsset,equationssetsetupinfo,err,error,*999)
4343  !Finalise the setup
4344  CALL equations_set_setup_finalise(equationssetsetupinfo,err,error,*999)
4345  !Set pointers
4346  IF(.NOT.equationsset%derived%derivedFieldAutoCreated) THEN
4347  equationsset%derived%derivedField=>derivedfield
4348  END IF
4349  ELSE
4350  CALL flagerror("Equation set region is not associated.",err,error,*999)
4351  END IF
4352  END IF
4353  ELSE
4354  CALL flagerror("Equations set is not associated.",err,error,*998)
4355  END IF
4356 
4357  exits("EquationsSet_DerivedCreateStart")
4358  RETURN
4359 999 CALL equationsset_derivedfinalise(equationsset%derived,dummyerr,dummyerror,*998)
4360 998 errorsexits("EquationsSet_DerivedCreateStart",err,error)
4361  RETURN 1
4362  END SUBROUTINE equationsset_derivedcreatestart
4363 
4364  !
4365  !================================================================================================================================
4366  !
4367 
4369  SUBROUTINE equationsset_deriveddestroy(equationsSet,err,error,*)
4370 
4371  !Argument variables
4372  TYPE(equations_set_type), POINTER :: equationsSet
4373  INTEGER(INTG), INTENT(OUT) :: err
4374  TYPE(varying_string), INTENT(OUT) :: error
4375  !Local Variables
4376 
4377  enters("EquationsSet_DerivedDestroy",err,error,*999)
4378 
4379  IF(ASSOCIATED(equationsset)) THEN
4380  CALL equationsset_derivedfinalise(equationsset%derived,err,error,*999)
4381  ELSE
4382  CALL flagerror("Equations set is not associated",err,error,*999)
4383  END IF
4384 
4385  exits("EquationsSet_DerivedDestroy")
4386  RETURN
4387 999 errorsexits("EquationsSet_DerivedDestroy",err,error)
4388  RETURN 1
4389  END SUBROUTINE equationsset_deriveddestroy
4390 
4391  !
4392  !================================================================================================================================
4393  !
4394 
4396  SUBROUTINE equationsset_derivedfinalise(equationsSetDerived,err,error,*)
4397 
4398  !Argument variables
4399  TYPE(equationssetderivedtype), POINTER :: equationsSetDerived
4400  INTEGER(INTG), INTENT(OUT) :: err
4401  TYPE(varying_string), INTENT(OUT) :: error
4402 
4403  enters("EquationsSet_DerivedFinalise",err,error,*999)
4404 
4405  IF(ASSOCIATED(equationssetderived)) THEN
4406  IF(ALLOCATED(equationssetderived%variableTypes)) DEALLOCATE(equationssetderived%variableTypes)
4407  DEALLOCATE(equationssetderived)
4408  END IF
4409 
4410  exits("EquationsSet_DerivedFinalise")
4411  RETURN
4412 999 errorsexits("EquationsSet_DerivedFinalise",err,error)
4413  RETURN 1
4414  END SUBROUTINE equationsset_derivedfinalise
4415 
4416  !
4417  !================================================================================================================================
4418  !
4419 
4421  SUBROUTINE equationsset_derivedinitialise(equationsSet,err,error,*)
4422 
4423  !Argument variables
4424  TYPE(equations_set_type), POINTER :: equationsSet
4425  INTEGER(INTG), INTENT(OUT) :: err
4426  TYPE(varying_string), INTENT(OUT) :: error
4427 
4428  enters("EquationsSet_DerivedInitialise",err,error,*999)
4429 
4430  IF(ASSOCIATED(equationsset)) THEN
4431  IF(ASSOCIATED(equationsset%derived)) THEN
4432  CALL flagerror("Derived information is already associated for this equations set.",err,error,*998)
4433  ELSE
4434  ALLOCATE(equationsset%derived,stat=err)
4435  IF(err/=0) CALL flagerror("Could not allocate equations set derived information.",err,error,*998)
4436  ALLOCATE(equationsset%derived%variableTypes(equations_set_number_of_derived_types),stat=err)
4437  IF(err/=0) CALL flagerror("Could not allocate equations set derived variable types.",err,error,*999)
4438  equationsset%derived%variableTypes=0
4439  equationsset%derived%numberOfVariables=0
4440  equationsset%derived%equationsSet=>equationsset
4441  equationsset%derived%derivedFinished=.false.
4442  equationsset%derived%derivedFieldAutoCreated=.false.
4443  NULLIFY(equationsset%derived%derivedField)
4444  END IF
4445  ELSE
4446  CALL flagerror("Equations set is not associated.",err,error,*999)
4447  END IF
4448 
4449  exits("EquationsSet_DerivedInitialise")
4450  RETURN
4451 999 CALL equationsset_derivedfinalise(equationsset%derived,err,error,*999)
4452 998 errorsexits("EquationsSet_DerivedInitialise",err,error)
4453  RETURN 1
4454  END SUBROUTINE equationsset_derivedinitialise
4455 
4456  !
4457  !================================================================================================================================
4458  !
4459 
4461  SUBROUTINE equations_set_equations_set_field_finalise(EQUATIONS_SET_FIELD,ERR,ERROR,*)
4462 
4463  !Argument variables
4464  TYPE(equations_set_equations_set_field_type) :: EQUATIONS_SET_FIELD
4465  INTEGER(INTG), INTENT(OUT) :: ERR
4466  TYPE(varying_string), INTENT(OUT) :: ERROR
4467  !Local Variables
4468 
4469  enters("EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE",err,error,*999)
4470 
4471  NULLIFY(equations_set_field%EQUATIONS_SET)
4472  equations_set_field%EQUATIONS_SET_FIELD_FINISHED=.false.
4473  equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED=.false.
4474  NULLIFY(equations_set_field%EQUATIONS_SET_FIELD_FIELD)
4475 
4476  exits("EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE")
4477  RETURN
4478 999 errorsexits("EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE",err,error)
4479  RETURN 1
4480  END SUBROUTINE equations_set_equations_set_field_finalise
4481 
4482  !
4483  !================================================================================================================================
4484  !
4486  SUBROUTINE equationsset_equationssetfieldinitialise(EQUATIONS_SET,ERR,ERROR,*)
4487 
4488  !Argument variables
4489  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4490  INTEGER(INTG), INTENT(OUT) :: ERR
4491  TYPE(varying_string), INTENT(OUT) :: ERROR
4492  !Local Variables
4493 
4494  enters("EquationsSet_EquationsSetFieldInitialise",err,error,*999)
4495 
4496  IF(ASSOCIATED(equations_set)) THEN
4497  equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET=>equations_set
4498  equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FINISHED=.false.
4499  equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED=.true.
4500  NULLIFY(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD)
4501  ELSE
4502  CALL flagerror("Equations set is not associated.",err,error,*999)
4503  ENDIF
4504 
4505  exits("EquationsSet_EquationsSetFieldInitialise")
4506  RETURN
4507 999 errorsexits("EquationsSet_EquationsSetFieldInitialise",err,error)
4508  RETURN 1
4509 
4510  END SUBROUTINE equationsset_equationssetfieldinitialise
4511 
4512  !
4513  !================================================================================================================================
4514  !
4515 
4516 
4517 
4519  SUBROUTINE equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP_INFO,ERR,ERROR,*)
4520 
4521  !Argument variables
4522  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4523  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP_INFO
4524  INTEGER(INTG), INTENT(OUT) :: ERR
4525  TYPE(varying_string), INTENT(OUT) :: ERROR
4526  !Local Variables
4527  TYPE(varying_string) :: LOCAL_ERROR
4528 
4529  enters("EQUATIONS_SET_SETUP",err,error,*999)
4530 
4531  IF(ASSOCIATED(equations_set)) THEN
4532  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
4533  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
4534  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
4535  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
4536  END IF
4537  SELECT CASE(equations_set%SPECIFICATION(1))
4538  CASE(equations_set_elasticity_class)
4539  CALL elasticity_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4540  CASE(equations_set_fluid_mechanics_class)
4541  CALL fluid_mechanics_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4542  CASE(equations_set_electromagnetics_class)
4543  CALL flagerror("Not implemented.",err,error,*999)
4544  CASE(equations_set_classical_field_class)
4545  CALL classical_field_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4546  CASE(equations_set_bioelectrics_class)
4547  IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
4548  CALL flagerror("Equations set specification must have at least two entries for a bioelectrics equation class.", &
4549  & err,error,*999)
4550  END IF
4551  IF(equations_set%SPECIFICATION(2) == equations_set_monodomain_strang_splitting_equation_type) THEN
4552  CALL monodomain_equation_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4553  ELSE
4554  CALL bioelectric_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4555  END IF
4556  CASE(equations_set_fitting_class)
4557  CALL fitting_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4558  CASE(equations_set_modal_class)
4559  CALL flagerror("Not implemented.",err,error,*999)
4560  CASE(equations_set_multi_physics_class)
4561  CALL multi_physics_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4562  CASE DEFAULT
4563  local_error="The first equations set specification of "// &
4564  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
4565  CALL flagerror(local_error,err,error,*999)
4566  END SELECT
4567  ELSE
4568  CALL flagerror("Equations set is not associated.",err,error,*999)
4569  ENDIF
4570 
4571  exits("EQUATIONS_SET_SETUP")
4572  RETURN
4573 999 errorsexits("EQUATIONS_SET_SETUP",err,error)
4574  RETURN 1
4575  END SUBROUTINE equations_set_setup
4576 
4577  !
4578  !================================================================================================================================
4579  !
4580 
4582  SUBROUTINE equations_set_equations_create_finish(EQUATIONS_SET,ERR,ERROR,*)
4583 
4584  !Argument variables
4585  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4586  INTEGER(INTG), INTENT(OUT) :: ERR
4587  TYPE(varying_string), INTENT(OUT) :: ERROR
4588  !Local Variables
4589  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
4590 
4591  enters("EQUATIONS_SET_EQUATIONS_CREATE_FINISH",err,error,*999)
4592 
4593  IF(ASSOCIATED(equations_set)) THEN
4594  !Initialise the setup
4595  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
4596  equations_set_setup_info%SETUP_TYPE=equations_set_setup_equations_type
4597  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
4598  !Finish the equations specific solution setup.
4599  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4600  !Finalise the setup
4601  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
4602  ELSE
4603  CALL flagerror("Equations set is not associated.",err,error,*999)
4604  ENDIF
4605 
4606  exits("EQUATIONS_SET_EQUATIONS_CREATE_FINISH")
4607  RETURN
4608 999 errorsexits("EQUATIONS_SET_EQUATIONS_CREATE_FINISH",err,error)
4609  RETURN 1
4610  END SUBROUTINE equations_set_equations_create_finish
4611 
4612  !
4613  !================================================================================================================================
4614  !
4615 
4627  SUBROUTINE equations_set_equations_create_start(EQUATIONS_SET,EQUATIONS,ERR,ERROR,*)
4628 
4629  !Argument variables
4630  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4631  TYPE(equations_type), POINTER :: EQUATIONS
4632  INTEGER(INTG), INTENT(OUT) :: ERR
4633  TYPE(varying_string), INTENT(OUT) :: ERROR
4634  !Local Variables
4635  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
4636 
4637  enters("EQUATIONS_SET_EQUATIONS_CREATE_START",err,error,*999)
4638 
4639  IF(ASSOCIATED(equations_set)) THEN
4640  IF(ASSOCIATED(equations)) THEN
4641  CALL flagerror("Equations is already associated.",err,error,*999)
4642  ELSE
4643  !Initialise the setup
4644  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
4645  equations_set_setup_info%SETUP_TYPE=equations_set_setup_equations_type
4646  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
4647  !Start the equations set specific solution setup
4648  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4649  !Finalise the setup
4650  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
4651  !Return the pointer
4652  equations=>equations_set%EQUATIONS
4653  ENDIF
4654  ELSE
4655  CALL flagerror("Equations set is not associated.",err,error,*999)
4656  ENDIF
4657 
4658  exits("EQUATIONS_SET_EQUATIONS_CREATE_START")
4659  RETURN
4660 999 errorsexits("EQUATIONS_SET_EQUATIONS_CREATE_START",err,error)
4661  RETURN 1
4662  END SUBROUTINE equations_set_equations_create_start
4663 
4664  !
4665  !================================================================================================================================
4666  !
4667 
4669  SUBROUTINE equations_set_equations_destroy(EQUATIONS_SET,ERR,ERROR,*)
4670 
4671  !Argument variables
4672  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4673  INTEGER(INTG), INTENT(OUT) :: ERR
4674  TYPE(varying_string), INTENT(OUT) :: ERROR
4675  !Local Variables
4676 
4677  enters("EQUATIONS_SET_EQUATIONS_DESTROY",err,error,*999)
4678 
4679  IF(ASSOCIATED(equations_set)) THEN
4680  IF(ASSOCIATED(equations_set%EQUATIONS)) THEN
4681  CALL equations_finalise(equations_set%EQUATIONS,err,error,*999)
4682  ELSE
4683  CALL flagerror("Equations set equations is not associated.",err,error,*999)
4684  ENDIF
4685  ELSE
4686  CALL flagerror("Equations set is not associated.",err,error,*999)
4687  ENDIF
4688 
4689  exits("EQUATIONS_SET_EQUATIONS_DESTROY")
4690  RETURN
4691 999 errorsexits("EQUATIONS_SET_EQUATIONS_DESTROY",err,error)
4692  RETURN 1
4693  END SUBROUTINE equations_set_equations_destroy
4694 
4695  !
4696  !================================================================================================================================
4697  !
4698 
4700  SUBROUTINE equations_set_jacobian_evaluate(EQUATIONS_SET,ERR,ERROR,*)
4701 
4702  !Argument variables
4703  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4704  INTEGER(INTG), INTENT(OUT) :: ERR
4705  TYPE(varying_string), INTENT(OUT) :: ERROR
4706  !Local Variables
4707  TYPE(equations_type), POINTER :: EQUATIONS
4708  TYPE(varying_string) :: LOCAL_ERROR
4709 
4710  enters("EQUATIONS_SET_JACOBIAN_EVALUATE",err,error,*999)
4711 
4712  IF(ASSOCIATED(equations_set)) THEN
4713  equations=>equations_set%EQUATIONS
4714  IF(ASSOCIATED(equations)) THEN
4715  IF(equations%EQUATIONS_FINISHED) THEN
4716  SELECT CASE(equations%LINEARITY)
4717  CASE(equations_linear)
4718  SELECT CASE(equations%TIME_DEPENDENCE)
4719  CASE(equations_static)
4720  SELECT CASE(equations_set%SOLUTION_METHOD)
4721  CASE(equations_set_fem_solution_method)
4722  CALL equations_set_assemble_static_linear_fem(equations_set,err,error,*999)
4723  CASE(equations_set_bem_solution_method)
4724  CALL flagerror("Not implemented.",err,error,*999)
4725  CASE(equations_set_fd_solution_method)
4726  CALL flagerror("Not implemented.",err,error,*999)
4727  CASE(equations_set_fv_solution_method)
4728  CALL flagerror("Not implemented.",err,error,*999)
4729  CASE(equations_set_gfem_solution_method)
4730  CALL flagerror("Not implemented.",err,error,*999)
4731  CASE(equations_set_gfv_solution_method)
4732  CALL flagerror("Not implemented.",err,error,*999)
4733  CASE DEFAULT
4734  local_error="The equations set solution method of "// &
4735  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4736  & " is invalid."
4737  CALL flagerror(local_error,err,error,*999)
4738  END SELECT
4739  CASE(equations_quasistatic)
4740  SELECT CASE(equations_set%SOLUTION_METHOD)
4741  CASE(equations_set_fem_solution_method)
4742  CALL equationsset_assemblequasistaticlinearfem(equations_set,err,error,*999)
4743  CASE(equations_set_bem_solution_method)
4744  CALL flagerror("Not implemented.",err,error,*999)
4745  CASE(equations_set_fd_solution_method)
4746  CALL flagerror("Not implemented.",err,error,*999)
4747  CASE(equations_set_fv_solution_method)
4748  CALL flagerror("Not implemented.",err,error,*999)
4749  CASE(equations_set_gfem_solution_method)
4750  CALL flagerror("Not implemented.",err,error,*999)
4751  CASE(equations_set_gfv_solution_method)
4752  CALL flagerror("Not implemented.",err,error,*999)
4753  CASE DEFAULT
4754  local_error="The equations set solution method of "// &
4755  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4756  & " is invalid."
4757  CALL flagerror(local_error,err,error,*999)
4758  END SELECT
4759  CASE(equations_first_order_dynamic,equations_second_order_dynamic)
4760  SELECT CASE(equations_set%SOLUTION_METHOD)
4761  CASE(equations_set_fem_solution_method)
4762  CALL equations_set_assemble_dynamic_linear_fem(equations_set,err,error,*999)
4763  CASE(equations_set_bem_solution_method)
4764  CALL flagerror("Not implemented.",err,error,*999)
4765  CASE(equations_set_fd_solution_method)
4766  CALL flagerror("Not implemented.",err,error,*999)
4767  CASE(equations_set_fv_solution_method)
4768  CALL flagerror("Not implemented.",err,error,*999)
4769  CASE(equations_set_gfem_solution_method)
4770  CALL flagerror("Not implemented.",err,error,*999)
4771  CASE(equations_set_gfv_solution_method)
4772  CALL flagerror("Not implemented.",err,error,*999)
4773  CASE DEFAULT
4774  local_error="The equations set solution method of "// &
4775  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4776  & " is invalid."
4777  CALL flagerror(local_error,err,error,*999)
4778  END SELECT
4779  CASE DEFAULT
4780  local_error="The equations time dependence type of "// &
4781  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
4782  CALL flagerror(local_error,err,error,*999)
4783  END SELECT
4784  CASE(equations_nonlinear)
4785  SELECT CASE(equations%TIME_DEPENDENCE)
4786  CASE(equations_static)
4787  SELECT CASE(equations_set%SOLUTION_METHOD)
4788  CASE(equations_set_fem_solution_method)
4789  CALL equations_set_jacobian_evaluate_static_fem(equations_set,err,error,*999)
4790  CASE(equations_set_nodal_solution_method)
4791  CALL equationsset_jacobianevaluatestaticnodal(equations_set,err,error,*999)
4792  CASE(equations_set_bem_solution_method)
4793  CALL flagerror("Not implemented.",err,error,*999)
4794  CASE(equations_set_fd_solution_method)
4795  CALL flagerror("Not implemented.",err,error,*999)
4796  CASE(equations_set_fv_solution_method)
4797  CALL flagerror("Not implemented.",err,error,*999)
4798  CASE(equations_set_gfem_solution_method)
4799  CALL flagerror("Not implemented.",err,error,*999)
4800  CASE(equations_set_gfv_solution_method)
4801  CALL flagerror("Not implemented.",err,error,*999)
4802  CASE DEFAULT
4803  local_error="The equations set solution method of "// &
4804  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4805  & " is invalid."
4806  CALL flagerror(local_error,err,error,*999)
4807  END SELECT
4808  CASE(equations_quasistatic)
4809  SELECT CASE(equations_set%SOLUTION_METHOD)
4810  CASE(equations_set_fem_solution_method)
4811  CALL equations_set_jacobian_evaluate_static_fem(equations_set,err,error,*999)
4812  CASE(equations_set_bem_solution_method)
4813  CALL flagerror("Not implemented.",err,error,*999)
4814  CASE(equations_set_fd_solution_method)
4815  CALL flagerror("Not implemented.",err,error,*999)
4816  CASE(equations_set_fv_solution_method)
4817  CALL flagerror("Not implemented.",err,error,*999)
4818  CASE(equations_set_gfem_solution_method)
4819  CALL flagerror("Not implemented.",err,error,*999)
4820  CASE(equations_set_gfv_solution_method)
4821  CALL flagerror("Not implemented.",err,error,*999)
4822  CASE DEFAULT
4823  local_error="The equations set solution method of "// &
4824  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4825  & " is invalid."
4826  CALL flagerror(local_error,err,error,*999)
4827  END SELECT
4828  CASE(equations_first_order_dynamic,equations_second_order_dynamic)
4829 ! sebk 15/09/09
4830  SELECT CASE(equations_set%SOLUTION_METHOD)
4831  CASE(equations_set_fem_solution_method)
4832  CALL equations_set_jacobian_evaluate_dynamic_fem(equations_set,err,error,*999)
4833  CASE(equations_set_bem_solution_method)
4834  CALL flagerror("Not implemented.",err,error,*999)
4835  CASE(equations_set_fd_solution_method)
4836  CALL flagerror("Not implemented.",err,error,*999)
4837  CASE(equations_set_fv_solution_method)
4838  CALL flagerror("Not implemented.",err,error,*999)
4839  CASE(equations_set_gfem_solution_method)
4840  CALL flagerror("Not implemented.",err,error,*999)
4841  CASE(equations_set_gfv_solution_method)
4842  CALL flagerror("Not implemented.",err,error,*999)
4843  CASE DEFAULT
4844  local_error="The equations set solution method of "// &
4845  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
4846  & " is invalid."
4847  CALL flagerror(local_error,err,error,*999)
4848  END SELECT
4849  CASE(equations_time_stepping)
4850  CALL flagerror("Not implemented.",err,error,*999)
4851  CASE DEFAULT
4852  local_error="The equations set time dependence type of "// &
4853  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
4854  CALL flagerror(local_error,err,error,*999)
4855  END SELECT
4856  CASE(equations_nonlinear_bcs)
4857  CALL flagerror("Not implemented.",err,error,*999)
4858  CASE DEFAULT
4859  local_error="The equations linearity of "// &
4860  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
4861  CALL flagerror(local_error,err,error,*999)
4862  END SELECT
4863  ELSE
4864  CALL flagerror("Equations have not been finished.",err,error,*999)
4865  ENDIF
4866  ELSE
4867  CALL flagerror("Equations set equations is not associated.",err,error,*999)
4868  ENDIF
4869  ELSE
4870  CALL flagerror("Equations set is not associated.",err,error,*999)
4871  ENDIF
4872 
4873  exits("EQUATIONS_SET_JACOBIAN_EVALUATE")
4874  RETURN
4875 999 errorsexits("EQUATIONS_SET_JACOBIAN_EVALUATE",err,error)
4876  RETURN 1
4877  END SUBROUTINE equations_set_jacobian_evaluate
4878 
4879  !
4880  !================================================================================================================================
4881  !
4882 
4884  SUBROUTINE equations_set_jacobian_evaluate_static_fem(EQUATIONS_SET,ERR,ERROR,*)
4885 
4886  !Argument variables
4887  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4888  INTEGER(INTG), INTENT(OUT) :: ERR
4889  TYPE(varying_string), INTENT(OUT) :: ERROR
4890  !Local Variables
4891  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
4892  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
4893  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
4894  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
4895  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
4896  TYPE(equations_type), POINTER :: EQUATIONS
4897  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4898  TYPE(field_type), POINTER :: DEPENDENT_FIELD
4899 
4900  enters("EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM",err,error,*999)
4901 
4902  IF(ASSOCIATED(equations_set)) THEN
4903  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4904  IF(ASSOCIATED(dependent_field)) THEN
4905  equations=>equations_set%EQUATIONS
4906  IF(ASSOCIATED(equations)) THEN
4907  equations_matrices=>equations%EQUATIONS_MATRICES
4908  IF(ASSOCIATED(equations_matrices)) THEN
4909  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
4910  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
4911  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
4912  ENDIF
4913 !!Do we need to transfer parameter sets???
4914  !Initialise the matrices and rhs vector
4915  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_jacobian_only,0.0_dp,err,error,*999)
4916  !Assemble the elements
4917  !Allocate the element matrices
4918  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
4919  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4920  & mappings%ELEMENTS
4921  !Output timing information if required
4922  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
4923  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
4924  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
4925  user_elapsed=user_time2(1)-user_time1(1)
4926  system_elapsed=system_time2(1)-system_time1(1)
4927  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
4928  & err,error,*999)
4929  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
4930  & err,error,*999)
4931  element_user_elapsed=0.0_sp
4932  element_system_elapsed=0.0_sp
4933  ENDIF
4934  number_of_times=0
4935  !Loop over the internal elements
4936  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
4937  ne=elements_mapping%DOMAIN_LIST(element_idx)
4938  number_of_times=number_of_times+1
4939  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
4940  CALL equationsset_finiteelementjacobianevaluate(equations_set,ne,err,error,*999)
4941  CALL equations_matrices_jacobian_element_add(equations_matrices,err,error,*999)
4942  ENDDO !element_idx
4943  !Output timing information if required
4944  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
4945  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
4946  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
4947  user_elapsed=user_time3(1)-user_time2(1)
4948  system_elapsed=system_time3(1)-system_time2(1)
4949  element_user_elapsed=user_elapsed
4950  element_system_elapsed=system_elapsed
4951  CALL write_string(general_output_type,"",err,error,*999)
4952  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
4953  & err,error,*999)
4954  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
4955  & err,error,*999)
4956  ENDIF
4957  !Output timing information if required
4958  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
4959  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
4960  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
4961  user_elapsed=user_time4(1)-user_time3(1)
4962  system_elapsed=system_time4(1)-system_time3(1)
4963  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
4964  & err,error,*999)
4965  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
4966  & err,error,*999)
4967  ENDIF
4968  !Loop over the boundary and ghost elements
4969  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
4970  ne=elements_mapping%DOMAIN_LIST(element_idx)
4971  number_of_times=number_of_times+1
4972  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
4973  CALL equationsset_finiteelementjacobianevaluate(equations_set,ne,err,error,*999)
4974  CALL equations_matrices_jacobian_element_add(equations_matrices,err,error,*999)
4975  ENDDO !element_idx
4976  !Output timing information if required
4977  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
4978  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
4979  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
4980  user_elapsed=user_time5(1)-user_time4(1)
4981  system_elapsed=system_time5(1)-system_time4(1)
4982  element_user_elapsed=element_user_elapsed+user_elapsed
4983  element_system_elapsed=element_system_elapsed+user_elapsed
4984  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
4985  & err,error,*999)
4986  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
4987  & err,error,*999)
4988  IF(number_of_times>0) THEN
4989  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
4990  & element_user_elapsed/number_of_times,err,error,*999)
4991  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
4992  & element_system_elapsed/number_of_times,err,error,*999)
4993  ENDIF
4994  ENDIF
4995  !Finalise the element matrices
4996  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
4997  !Output equations matrices and RHS vector if required
4998  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
4999  CALL equations_matrices_jacobian_output(general_output_type,equations_matrices,err,error,*999)
5000  ENDIF
5001  !Output timing information if required
5002  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5003  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
5004  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
5005  user_elapsed=user_time6(1)-user_time1(1)
5006  system_elapsed=system_time6(1)-system_time1(1)
5007  CALL write_string(general_output_type,"",err,error,*999)
5008  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
5009  & err,error,*999)
5010  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
5011  & err,error,*999)
5012  ENDIF
5013  ELSE
5014  CALL flagerror("Equations matrices is not associated",err,error,*999)
5015  ENDIF
5016  ELSE
5017  CALL flagerror("Equations is not associated",err,error,*999)
5018  ENDIF
5019  ELSE
5020  CALL flagerror("Dependent field is not associated",err,error,*999)
5021  ENDIF
5022  ELSE
5023  CALL flagerror("Equations set is not associated.",err,error,*999)
5024  ENDIF
5025 
5026  exits("EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM")
5027  RETURN
5028 999 errorsexits("EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM",err,error)
5029  RETURN 1
5030  END SUBROUTINE equations_set_jacobian_evaluate_static_fem
5031 
5032  !
5033  !================================================================================================================================
5034  !
5035 
5037  SUBROUTINE equations_set_jacobian_evaluate_dynamic_fem(EQUATIONS_SET,ERR,ERROR,*)
5038 
5039  !Argument variables
5040  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5041  INTEGER(INTG), INTENT(OUT) :: ERR
5042  TYPE(varying_string), INTENT(OUT) :: ERROR
5043  !Local Variables
5044  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
5045  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
5046  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
5047  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
5048  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
5049  TYPE(equations_type), POINTER :: EQUATIONS
5050  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5051  TYPE(field_type), POINTER :: DEPENDENT_FIELD
5052 
5053  enters("EQUATIONS_SET_JACOBIAN_EVALUATE_DYNAMIC_FEM",err,error,*999)
5054 
5055  IF(ASSOCIATED(equations_set)) THEN
5056  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
5057  IF(ASSOCIATED(dependent_field)) THEN
5058  equations=>equations_set%EQUATIONS
5059  IF(ASSOCIATED(equations)) THEN
5060  equations_matrices=>equations%EQUATIONS_MATRICES
5061  IF(ASSOCIATED(equations_matrices)) THEN
5062  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5063  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
5064  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
5065  ENDIF
5066 !!Do we need to transfer parameter sets???
5067  !Initialise the matrices and rhs vector
5068  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_jacobian_only,0.0_dp,err,error,*999)
5069  !Assemble the elements
5070  !Allocate the element matrices
5071  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
5072  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
5073  & mappings%ELEMENTS
5074  !Output timing information if required
5075  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5076  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
5077  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
5078  user_elapsed=user_time2(1)-user_time1(1)
5079  system_elapsed=system_time2(1)-system_time1(1)
5080  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
5081  & err,error,*999)
5082  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
5083  & err,error,*999)
5084  element_user_elapsed=0.0_sp
5085  element_system_elapsed=0.0_sp
5086  ENDIF
5087  number_of_times=0
5088  !Loop over the internal elements
5089  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
5090  ne=elements_mapping%DOMAIN_LIST(element_idx)
5091  number_of_times=number_of_times+1
5092  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5093  CALL equationsset_finiteelementjacobianevaluate(equations_set,ne,err,error,*999)
5094  CALL equations_matrices_jacobian_element_add(equations_matrices,err,error,*999)
5095  ENDDO !element_idx
5096  !Output timing information if required
5097  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5098  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
5099  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
5100  user_elapsed=user_time3(1)-user_time2(1)
5101  system_elapsed=system_time3(1)-system_time2(1)
5102  element_user_elapsed=user_elapsed
5103  element_system_elapsed=system_elapsed
5104  CALL write_string(general_output_type,"",err,error,*999)
5105  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
5106  & err,error,*999)
5107  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
5108  & err,error,*999)
5109  ENDIF
5110  !Output timing information if required
5111  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5112  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
5113  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
5114  user_elapsed=user_time4(1)-user_time3(1)
5115  system_elapsed=system_time4(1)-system_time3(1)
5116  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
5117  & err,error,*999)
5118  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
5119  & err,error,*999)
5120  ENDIF
5121  !Loop over the boundary and ghost elements
5122  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
5123  ne=elements_mapping%DOMAIN_LIST(element_idx)
5124  number_of_times=number_of_times+1
5125  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5126  CALL equationsset_finiteelementjacobianevaluate(equations_set,ne,err,error,*999)
5127  CALL equations_matrices_jacobian_element_add(equations_matrices,err,error,*999)
5128  ENDDO !element_idx
5129  !Output timing information if required
5130  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5131  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
5132  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
5133  user_elapsed=user_time5(1)-user_time4(1)
5134  system_elapsed=system_time5(1)-system_time4(1)
5135  element_user_elapsed=element_user_elapsed+user_elapsed
5136  element_system_elapsed=element_system_elapsed+user_elapsed
5137  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
5138  & err,error,*999)
5139  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
5140  & err,error,*999)
5141  IF(number_of_times>0) THEN
5142  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
5143  & element_user_elapsed/number_of_times,err,error,*999)
5144  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
5145  & element_system_elapsed/number_of_times,err,error,*999)
5146  ENDIF
5147  ENDIF
5148  !Finalise the element matrices
5149  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
5150  !Output equations matrices and RHS vector if required
5151  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
5152  CALL equations_matrices_jacobian_output(general_output_type,equations_matrices,err,error,*999)
5153  ENDIF
5154  !Output timing information if required
5155  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5156  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
5157  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
5158  user_elapsed=user_time6(1)-user_time1(1)
5159  system_elapsed=system_time6(1)-system_time1(1)
5160  CALL write_string(general_output_type,"",err,error,*999)
5161  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
5162  & err,error,*999)
5163  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
5164  & err,error,*999)
5165  ENDIF
5166  ELSE
5167  CALL flagerror("Equations matrices is not associated",err,error,*999)
5168  ENDIF
5169  ELSE
5170  CALL flagerror("Equations is not associated",err,error,*999)
5171  ENDIF
5172  ELSE
5173  CALL flagerror("Dependent field is not associated",err,error,*999)
5174  ENDIF
5175  ELSE
5176  CALL flagerror("Equations set is not associated.",err,error,*999)
5177  ENDIF
5178 
5179  exits("EQUATIONS_SET_JACOBIAN_EVALUATE_DYNAMIC_FEM")
5180  RETURN
5181 999 errorsexits("EQUATIONS_SET_JACOBIAN_EVALUATE_DYNAMIC_FEM",err,error)
5182  RETURN 1
5183  END SUBROUTINE equations_set_jacobian_evaluate_dynamic_fem
5184 
5185  !
5186  !================================================================================================================================
5187  !
5188 
5190  SUBROUTINE equations_set_residual_evaluate(EQUATIONS_SET,ERR,ERROR,*)
5191 
5192  !Argument variables
5193  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5194  INTEGER(INTG), INTENT(OUT) :: ERR
5195  TYPE(varying_string), INTENT(OUT) :: ERROR
5196  !Local Variables
5197  INTEGER(INTG) :: residual_variable_idx
5198  TYPE(equations_type), POINTER :: EQUATIONS
5199  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5200  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
5201  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
5202  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
5203  TYPE(field_parameter_set_type), POINTER :: RESIDUAL_PARAMETER_SET
5204  TYPE(field_variable_type), POINTER :: RESIDUAL_VARIABLE
5205  TYPE(varying_string) :: LOCAL_ERROR
5206 
5207  enters("EQUATIONS_SET_RESIDUAL_EVALUATE",err,error,*999)
5208 
5209  IF(ASSOCIATED(equations_set)) THEN
5210  equations=>equations_set%EQUATIONS
5211  IF(ASSOCIATED(equations)) THEN
5212  IF(equations%EQUATIONS_FINISHED) THEN
5213  SELECT CASE(equations%LINEARITY)
5214  CASE(equations_linear)
5215  CALL flagerror("Can not evaluate a residual for linear equations.",err,error,*999)
5216  CASE(equations_nonlinear)
5217  SELECT CASE(equations%TIME_DEPENDENCE)
5218  CASE(equations_static,equations_quasistatic)!Quasistatic handled like static
5219  SELECT CASE(equations_set%SOLUTION_METHOD)
5220  CASE(equations_set_fem_solution_method)
5221  CALL equations_set_residual_evaluate_static_fem(equations_set,err,error,*999)
5222  CASE(equations_set_nodal_solution_method)
5223  CALL equationsset_residualevaluatestaticnodal(equations_set,err,error,*999)
5224  CASE(equations_set_bem_solution_method)
5225  CALL flagerror("Not implemented.",err,error,*999)
5226  CASE(equations_set_fd_solution_method)
5227  CALL flagerror("Not implemented.",err,error,*999)
5228  CASE(equations_set_fv_solution_method)
5229  CALL flagerror("Not implemented.",err,error,*999)
5230  CASE(equations_set_gfem_solution_method)
5231  CALL flagerror("Not implemented.",err,error,*999)
5232  CASE(equations_set_gfv_solution_method)
5233  CALL flagerror("Not implemented.",err,error,*999)
5234  CASE DEFAULT
5235  local_error="The equations set solution method of "// &
5236  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
5237  & " is invalid."
5238  CALL flagerror(local_error,err,error,*999)
5239  END SELECT
5240  CASE(equations_first_order_dynamic,equations_second_order_dynamic)
5241  SELECT CASE(equations_set%SOLUTION_METHOD)
5242  CASE(equations_set_fem_solution_method)
5243  CALL equations_set_residual_evaluate_dynamic_fem(equations_set,err,error,*999)
5244  CASE(equations_set_bem_solution_method)
5245  CALL flagerror("Not implemented.",err,error,*999)
5246  CASE(equations_set_fd_solution_method)
5247  CALL flagerror("Not implemented.",err,error,*999)
5248  CASE(equations_set_fv_solution_method)
5249  CALL flagerror("Not implemented.",err,error,*999)
5250  CASE(equations_set_gfem_solution_method)
5251  CALL flagerror("Not implemented.",err,error,*999)
5252  CASE(equations_set_gfv_solution_method)
5253  CALL flagerror("Not implemented.",err,error,*999)
5254  CASE DEFAULT
5255  local_error="The equations set solution method of "// &
5256  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
5257  & " is invalid."
5258  CALL flagerror(local_error,err,error,*999)
5259  END SELECT
5260  CASE DEFAULT
5261  local_error="The equations set time dependence type of "// &
5262  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
5263  CALL flagerror(local_error,err,error,*999)
5264  END SELECT
5265  CASE(equations_nonlinear_bcs)
5266  CALL flagerror("Not implemented.",err,error,*999)
5267  CASE DEFAULT
5268  local_error="The equations linearity of "// &
5269  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
5270  CALL flagerror(local_error,err,error,*999)
5271  END SELECT
5272  !Update the residual parameter set if it exists
5273  equations_mapping=>equations%EQUATIONS_MAPPING
5274  IF(ASSOCIATED(equations_mapping)) THEN
5275  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5276  IF(ASSOCIATED(nonlinear_mapping)) THEN
5277  DO residual_variable_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
5278  residual_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(residual_variable_idx)%PTR
5279  IF(ASSOCIATED(residual_variable)) THEN
5280  residual_parameter_set=>residual_variable%PARAMETER_SETS%SET_TYPE(field_residual_set_type)%PTR
5281  IF(ASSOCIATED(residual_parameter_set)) THEN
5282  !Residual parameter set exists
5283  equations_matrices=>equations%EQUATIONS_MATRICES
5284  IF(ASSOCIATED(equations_matrices)) THEN
5285  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5286  IF(ASSOCIATED(nonlinear_matrices)) THEN
5287  !Copy the residual vector to the residuals parameter set.
5288  CALL distributed_vector_copy(nonlinear_matrices%RESIDUAL,residual_parameter_set%PARAMETERS,1.0_dp, &
5289  & err,error,*999)
5290  ELSE
5291  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
5292  ENDIF
5293  ELSE
5294  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
5295  ENDIF
5296  ENDIF
5297  ELSE
5298  local_error="Nonlinear mapping residual variable for residual variable index "// &
5299  & trim(number_to_vstring(residual_variable_idx,"*",err,error))//" is not associated."
5300  CALL flagerror(local_error,err,error,*999)
5301  ENDIF
5302  ENDDO !residual_variable_idx
5303  ELSE
5304  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
5305  ENDIF
5306  ELSE
5307  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
5308  ENDIF
5309  ELSE
5310  CALL flagerror("Equations have not been finished.",err,error,*999)
5311  ENDIF
5312  ELSE
5313  CALL flagerror("Equations set equations is not associated.",err,error,*999)
5314  ENDIF
5315  ELSE
5316  CALL flagerror("Equations set is not associated.",err,error,*999)
5317  ENDIF
5318 
5319  exits("EQUATIONS_SET_RESIDUAL_EVALUATE")
5320  RETURN
5321 999 errorsexits("EQUATIONS_SET_RESIDUAL_EVALUATE",err,error)
5322  RETURN 1
5323 
5324  END SUBROUTINE equations_set_residual_evaluate
5325 
5326  !
5327  !================================================================================================================================
5328  !
5329 
5331  SUBROUTINE equations_set_residual_evaluate_dynamic_fem(EQUATIONS_SET,ERR,ERROR,*)
5332 
5333  !Argument variables
5334  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5335  INTEGER(INTG), INTENT(OUT) :: ERR
5336  TYPE(varying_string), INTENT(OUT) :: ERROR
5337  !Local Variables
5338  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
5339  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
5340  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
5341  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
5342  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
5343  TYPE(equations_type), POINTER :: EQUATIONS
5344  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5345  TYPE(field_type), POINTER :: DEPENDENT_FIELD
5346 
5347  enters("EQUATIONS_SET_RESIDUAL_EVALUATE_DYNAMIC_FEM",err,error,*999)
5348 
5349  NULLIFY(elements_mapping)
5350  NULLIFY(equations)
5351  NULLIFY(equations_matrices)
5352  NULLIFY(dependent_field)
5353 
5354  IF(ASSOCIATED(equations_set)) THEN
5355  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
5356  IF(ASSOCIATED(dependent_field)) THEN
5357  equations=>equations_set%EQUATIONS
5358  IF(ASSOCIATED(equations)) THEN
5359  equations_matrices=>equations%EQUATIONS_MATRICES
5360  IF(ASSOCIATED(equations_matrices)) THEN
5361  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5362  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
5363  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
5364  ENDIF
5365  !!Do we need to transfer parameter sets???
5366  !Initialise the matrices and rhs vector
5367  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_nonlinear_only,0.0_dp,err,error,*999)
5368  !Assemble the elements
5369  !Allocate the element matrices
5370  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
5371  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
5372  & mappings%ELEMENTS
5373  !Output timing information if required
5374  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5375  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
5376  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
5377  user_elapsed=user_time2(1)-user_time1(1)
5378  system_elapsed=system_time2(1)-system_time1(1)
5379  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
5380  & err,error,*999)
5381  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
5382  & err,error,*999)
5383  element_user_elapsed=0.0_sp
5384  element_system_elapsed=0.0_sp
5385  ENDIF
5386  number_of_times=0
5387  !Loop over the internal elements
5388  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
5389  ne=elements_mapping%DOMAIN_LIST(element_idx)
5390  number_of_times=number_of_times+1
5391  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5392  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
5393  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
5394  ENDDO !element_idx
5395  !Output timing information if required
5396  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5397  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
5398  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
5399  user_elapsed=user_time3(1)-user_time2(1)
5400  system_elapsed=system_time3(1)-system_time2(1)
5401  element_user_elapsed=user_elapsed
5402  element_system_elapsed=system_elapsed
5403  CALL write_string(general_output_type,"",err,error,*999)
5404  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
5405  & err,error,*999)
5406  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
5407  & err,error,*999)
5408  ENDIF
5409  !Output timing information if required
5410  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5411  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
5412  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
5413  user_elapsed=user_time4(1)-user_time3(1)
5414  system_elapsed=system_time4(1)-system_time3(1)
5415  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
5416  & err,error,*999)
5417  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
5418  & err,error,*999)
5419  ENDIF
5420  !Loop over the boundary and ghost elements
5421  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
5422  ne=elements_mapping%DOMAIN_LIST(element_idx)
5423  number_of_times=number_of_times+1
5424  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5425  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
5426  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
5427  ENDDO !element_idx
5428  !Output timing information if required
5429  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5430  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
5431  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
5432  user_elapsed=user_time5(1)-user_time4(1)
5433  system_elapsed=system_time5(1)-system_time4(1)
5434  element_user_elapsed=element_user_elapsed+user_elapsed
5435  element_system_elapsed=element_system_elapsed+user_elapsed
5436  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
5437  & err,error,*999)
5438  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
5439  & err,error,*999)
5440  IF(number_of_times>0) THEN
5441  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
5442  & element_user_elapsed/number_of_times,err,error,*999)
5443  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
5444  & element_system_elapsed/number_of_times,err,error,*999)
5445  ENDIF
5446  ENDIF
5447  !Finalise the element matrices
5448  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
5449  !Output equations matrices and RHS vector if required
5450  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
5451  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
5452  ENDIF
5453  !Output timing information if required
5454  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5455  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
5456  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
5457  user_elapsed=user_time6(1)-user_time1(1)
5458  system_elapsed=system_time6(1)-system_time1(1)
5459  CALL write_string(general_output_type,"",err,error,*999)
5460  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
5461  & err,error,*999)
5462  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
5463  & err,error,*999)
5464  ENDIF
5465  ELSE
5466  CALL flagerror("Equations matrices is not associated",err,error,*999)
5467  ENDIF
5468  ELSE
5469  CALL flagerror("Equations is not associated",err,error,*999)
5470  ENDIF
5471  ELSE
5472  CALL flagerror("Dependent field is not associated",err,error,*999)
5473  ENDIF
5474  ELSE
5475  CALL flagerror("Equations set is not associated.",err,error,*999)
5476  ENDIF
5477 
5478  exits("EQUATIONS_SET_RESIDUAL_EVALUATE_DYNAMIC_FEM")
5479  RETURN
5480 999 errorsexits("EQUATIONS_SET_RESIDUAL_EVALUATE_DYNAMIC_FEM",err,error)
5481  RETURN 1
5482  END SUBROUTINE equations_set_residual_evaluate_dynamic_fem
5483 
5484  !
5485  !================================================================================================================================
5486  !
5487 
5489  SUBROUTINE equations_set_residual_evaluate_static_fem(EQUATIONS_SET,ERR,ERROR,*)
5490 
5491  !Argument variables
5492  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5493  INTEGER(INTG), INTENT(OUT) :: ERR
5494  TYPE(varying_string), INTENT(OUT) :: ERROR
5495  !Local Variables
5496  INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
5497  REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
5498  & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
5499  & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
5500  TYPE(domain_mapping_type), POINTER :: ELEMENTS_MAPPING
5501  TYPE(equations_type), POINTER :: EQUATIONS
5502  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5503  TYPE(field_type), POINTER :: DEPENDENT_FIELD
5504 
5505  enters("EQUATIONS_SET_RESIDUAL_EVALUATE_STATIC_FEM",err,error,*999)
5506 
5507  IF(ASSOCIATED(equations_set)) THEN
5508  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
5509  IF(ASSOCIATED(dependent_field)) THEN
5510  equations=>equations_set%EQUATIONS
5511  IF(ASSOCIATED(equations)) THEN
5512  equations_matrices=>equations%EQUATIONS_MATRICES
5513  IF(ASSOCIATED(equations_matrices)) THEN
5514  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5515  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
5516  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
5517  ENDIF
5518  !!Do we need to transfer parameter sets???
5519  !Initialise the matrices and rhs vector
5520  CALL equations_matrices_values_initialise(equations_matrices,equations_matrices_nonlinear_only,0.0_dp,err,error,*999)
5521  !Assemble the elements
5522  !Allocate the element matrices
5523  CALL equations_matrices_element_initialise(equations_matrices,err,error,*999)
5524  elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
5525  & mappings%ELEMENTS
5526  !Output timing information if required
5527  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5528  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
5529  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
5530  user_elapsed=user_time2(1)-user_time1(1)
5531  system_elapsed=system_time2(1)-system_time1(1)
5532  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",user_elapsed, &
5533  & err,error,*999)
5534  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",system_elapsed, &
5535  & err,error,*999)
5536  element_user_elapsed=0.0_sp
5537  element_system_elapsed=0.0_sp
5538  ENDIF
5539  number_of_times=0
5540  !Loop over the internal elements
5541  DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
5542  ne=elements_mapping%DOMAIN_LIST(element_idx)
5543  number_of_times=number_of_times+1
5544  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5545  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
5546  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
5547  ENDDO !element_idx
5548  !Output timing information if required
5549  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5550  CALL cpu_timer(user_cpu,user_time3,err,error,*999)
5551  CALL cpu_timer(system_cpu,system_time3,err,error,*999)
5552  user_elapsed=user_time3(1)-user_time2(1)
5553  system_elapsed=system_time3(1)-system_time2(1)
5554  element_user_elapsed=user_elapsed
5555  element_system_elapsed=system_elapsed
5556  CALL write_string(general_output_type,"",err,error,*999)
5557  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",user_elapsed, &
5558  & err,error,*999)
5559  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",system_elapsed, &
5560  & err,error,*999)
5561  ENDIF
5562  !Output timing information if required
5563  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5564  CALL cpu_timer(user_cpu,user_time4,err,error,*999)
5565  CALL cpu_timer(system_cpu,system_time4,err,error,*999)
5566  user_elapsed=user_time4(1)-user_time3(1)
5567  system_elapsed=system_time4(1)-system_time3(1)
5568  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",user_elapsed, &
5569  & err,error,*999)
5570  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",system_elapsed, &
5571  & err,error,*999)
5572  ENDIF
5573  !Loop over the boundary and ghost elements
5574  DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
5575  ne=elements_mapping%DOMAIN_LIST(element_idx)
5576  number_of_times=number_of_times+1
5577  CALL equations_matrices_element_calculate(equations_matrices,ne,err,error,*999)
5578  CALL equationsset_finiteelementresidualevaluate(equations_set,ne,err,error,*999)
5579  CALL equations_matrices_element_add(equations_matrices,err,error,*999)
5580  ENDDO !element_idx
5581  !Output timing information if required
5582  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5583  CALL cpu_timer(user_cpu,user_time5,err,error,*999)
5584  CALL cpu_timer(system_cpu,system_time5,err,error,*999)
5585  user_elapsed=user_time5(1)-user_time4(1)
5586  system_elapsed=system_time5(1)-system_time4(1)
5587  element_user_elapsed=element_user_elapsed+user_elapsed
5588  element_system_elapsed=element_system_elapsed+user_elapsed
5589  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",user_elapsed, &
5590  & err,error,*999)
5591  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",system_elapsed, &
5592  & err,error,*999)
5593  IF(number_of_times>0) THEN
5594  CALL write_string_value(general_output_type,"Average element user time for equations assembly = ", &
5595  & element_user_elapsed/number_of_times,err,error,*999)
5596  CALL write_string_value(general_output_type,"Average element system time for equations assembly = ", &
5597  & element_system_elapsed/number_of_times,err,error,*999)
5598  ENDIF
5599  ENDIF
5600  !Finalise the element matrices
5601  CALL equations_matrices_element_finalise(equations_matrices,err,error,*999)
5602  !Output equations matrices and RHS vector if required
5603  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
5604  CALL equations_matrices_output(general_output_type,equations_matrices,err,error,*999)
5605  ENDIF
5606  !Output timing information if required
5607  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
5608  CALL cpu_timer(user_cpu,user_time6,err,error,*999)
5609  CALL cpu_timer(system_cpu,system_time6,err,error,*999)
5610  user_elapsed=user_time6(1)-user_time1(1)
5611  system_elapsed=system_time6(1)-system_time1(1)
5612  CALL write_string(general_output_type,"",err,error,*999)
5613  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",user_elapsed, &
5614  & err,error,*999)
5615  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",system_elapsed, &
5616  & err,error,*999)
5617  ENDIF
5618  ELSE
5619  CALL flagerror("Equations matrices is not associated",err,error,*999)
5620  ENDIF
5621  ELSE
5622  CALL flagerror("Equations is not associated",err,error,*999)
5623  ENDIF
5624  ELSE
5625  CALL flagerror("Dependent field is not associated",err,error,*999)
5626  ENDIF
5627  ELSE
5628  CALL flagerror("Equations set is not associated.",err,error,*999)
5629  ENDIF
5630 
5631  exits("EQUATIONS_SET_RESIDUAL_EVALUATE_STATIC_FEM")
5632  RETURN
5633 999 errorsexits("EQUATIONS_SET_RESIDUAL_EVALUATE_STATIC_FEM",err,error)
5634  RETURN 1
5635  END SUBROUTINE equations_set_residual_evaluate_static_fem
5636 
5637  !
5638  !================================================================================================================================
5639  !
5640 
5642  SUBROUTINE equations_set_setup_finalise(EQUATIONS_SET_SETUP_INFO,ERR,ERROR,*)
5643 
5644  !Argument variables
5645  TYPE(equations_set_setup_type), INTENT(OUT) :: EQUATIONS_SET_SETUP_INFO
5646  INTEGER(INTG), INTENT(OUT) :: ERR
5647  TYPE(varying_string), INTENT(OUT) :: ERROR
5648  !Local Variables
5649 
5650  enters("EQUATIONS_SET_SETUP_FINALISE",err,error,*999)
5651 
5652  equations_set_setup_info%SETUP_TYPE=0
5653  equations_set_setup_info%ACTION_TYPE=0
5654  equations_set_setup_info%FIELD_USER_NUMBER=0
5655  NULLIFY(equations_set_setup_info%FIELD)
5656  equations_set_setup_info%ANALYTIC_FUNCTION_TYPE=0
5657 
5658  exits("EQUATIONS_SET_SETUP_FINALISE")
5659  RETURN
5660 999 errorsexits("EQUATIONS_SET_SETUP_FINALISE",err,error)
5661  RETURN 1
5662  END SUBROUTINE equations_set_setup_finalise
5663 
5664  !
5665  !================================================================================================================================
5666  !
5667 
5669  SUBROUTINE equations_set_setup_initialise(EQUATIONS_SET_SETUP_INFO,ERR,ERROR,*)
5670 
5671  !Argument variables
5672  TYPE(equations_set_setup_type), INTENT(OUT) :: EQUATIONS_SET_SETUP_INFO
5673  INTEGER(INTG), INTENT(OUT) :: ERR
5674  TYPE(varying_string), INTENT(OUT) :: ERROR
5675  !Local Variables
5676 
5677  enters("EQUATIONS_SET_SETUP_INITIALISE",err,error,*999)
5678 
5679  equations_set_setup_info%SETUP_TYPE=0
5680  equations_set_setup_info%ACTION_TYPE=0
5681  equations_set_setup_info%FIELD_USER_NUMBER=0
5682  NULLIFY(equations_set_setup_info%FIELD)
5683  equations_set_setup_info%ANALYTIC_FUNCTION_TYPE=0
5684 
5685  exits("EQUATIONS_SET_SETUP_INITIALISE")
5686  RETURN
5687 999 errorsexits("EQUATIONS_SET_SETUP_INITIALISE",err,error)
5688  RETURN 1
5689  END SUBROUTINE equations_set_setup_initialise
5690 
5691  !
5692  !================================================================================================================================
5693  !
5694 
5696  SUBROUTINE equations_set_solution_method_set(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
5697 
5698  !Argument variables
5699  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5700  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
5701  INTEGER(INTG), INTENT(OUT) :: ERR
5702  TYPE(varying_string), INTENT(OUT) :: ERROR
5703  !Local Variables
5704  TYPE(varying_string) :: LOCAL_ERROR
5705 
5706  enters("EQUATIONS_SET_SOLUTION_METHOD_SET",err,error,*999)
5707 
5708  IF(ASSOCIATED(equations_set)) THEN
5709  IF(equations_set%EQUATIONS_SET_FINISHED) THEN
5710  CALL flagerror("Equations set has already been finished.",err,error,*999)
5711  ELSE
5712  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
5713  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
5714  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
5715  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
5716  END IF
5717  SELECT CASE(equations_set%SPECIFICATION(1))
5718  CASE(equations_set_elasticity_class)
5719  CALL elasticity_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
5720  CASE(equations_set_fluid_mechanics_class)
5721  CALL fluidmechanics_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
5722  CASE(equations_set_electromagnetics_class)
5723  CALL flagerror("Not implemented.",err,error,*999)
5724  CASE(equations_set_classical_field_class)
5725  CALL classicalfield_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
5726  CASE(equations_set_bioelectrics_class)
5727  IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
5728  CALL flagerror("Equations set specification must have at least two entries for a bioelectrics equation set.", &
5729  & err,error,*999)
5730  END IF
5731  IF(equations_set%SPECIFICATION(2) == equations_set_monodomain_strang_splitting_equation_type) THEN
5732  CALL monodomain_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
5733  ELSE
5734  CALL bioelectric_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
5735  END IF
5736  CASE(equations_set_modal_class)
5737  CALL flagerror("Not implemented.",err,error,*999)
5738  CASE(equations_set_multi_physics_class)
5739  CALL multiphysics_equationssetsolnmethodset(equations_set,solution_method,err,error,*999)
5740  CASE DEFAULT
5741  local_error="The first equations set specification of "// &
5742  & trim(number_to_vstring(equations_set%SPECIFICATION(1),"*",err,error))//" is invalid."
5743  CALL flagerror(local_error,err,error,*999)
5744  END SELECT
5745  ENDIF
5746  ELSE
5747  CALL flagerror("Equations set is not associated.",err,error,*999)
5748  ENDIF
5749 
5750  exits("EQUATIONS_SET_SOLUTION_METHOD_SET")
5751  RETURN
5752 999 errorsexits("EQUATIONS_SET_SOLUTION_METHOD_SET",err,error)
5753  RETURN 1
5754 
5755  END SUBROUTINE equations_set_solution_method_set
5756 
5757  !
5758  !================================================================================================================================
5759  !
5760 
5762  SUBROUTINE equations_set_solution_method_get(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
5763 
5764  !Argument variables
5765  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5766  INTEGER(INTG), INTENT(OUT) :: SOLUTION_METHOD
5767  INTEGER(INTG), INTENT(OUT) :: ERR
5768  TYPE(varying_string), INTENT(OUT) :: ERROR
5769  !Local Variables
5770 
5771  enters("EQUATIONS_SET_SOLUTION_METHOD_GET",err,error,*999)
5772 
5773  IF(ASSOCIATED(equations_set)) THEN
5774  IF(equations_set%EQUATIONS_SET_FINISHED) THEN
5775  solution_method=equations_set%SOLUTION_METHOD
5776  ELSE
5777  CALL flagerror("Equations set has not been finished.",err,error,*999)
5778  ENDIF
5779  ELSE
5780  CALL flagerror("Equations set is not associated.",err,error,*999)
5781  ENDIF
5782 
5783  exits("EQUATIONS_SET_SOLUTION_METHOD_GET")
5784  RETURN
5785 999 errorsexits("EQUATIONS_SET_SOLUTION_METHOD_GET",err,error)
5786  RETURN 1
5787  END SUBROUTINE equations_set_solution_method_get
5788 
5789  !
5790  !================================================================================================================================
5791  !
5792 
5794  SUBROUTINE equations_set_source_create_finish(EQUATIONS_SET,ERR,ERROR,*)
5795 
5796  !Argument variables
5797  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5798  INTEGER(INTG), INTENT(OUT) :: ERR
5799  TYPE(varying_string), INTENT(OUT) :: ERROR
5800  !Local Variables
5801  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
5802  TYPE(field_type), POINTER :: SOURCE_FIELD
5803 
5804  enters("EQUATIONS_SET_SOURCE_CREATE_FINISH",err,error,*999)
5805 
5806  IF(ASSOCIATED(equations_set)) THEN
5807  IF(ASSOCIATED(equations_set%SOURCE)) THEN
5808  IF(equations_set%SOURCE%SOURCE_FINISHED) THEN
5809  CALL flagerror("Equations set source has already been finished.",err,error,*999)
5810  ELSE
5811  !Initialise the setup
5812  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
5813  equations_set_setup_info%SETUP_TYPE=equations_set_setup_source_type
5814  equations_set_setup_info%ACTION_TYPE=equations_set_setup_finish_action
5815  source_field=>equations_set%SOURCE%SOURCE_FIELD
5816  IF(ASSOCIATED(source_field)) THEN
5817  equations_set_setup_info%FIELD_USER_NUMBER=source_field%USER_NUMBER
5818  equations_set_setup_info%FIELD=>source_field
5819  !Finish the equation set specific source setup
5820  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
5821  ELSE
5822  CALL flagerror("Equations set source source field is not associated.",err,error,*999)
5823  ENDIF
5824  !Finalise the setup
5825  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
5826  !Finish the source creation
5827  equations_set%SOURCE%SOURCE_FINISHED=.true.
5828  ENDIF
5829  ELSE
5830  CALL flagerror("The equations set source is not associated.",err,error,*999)
5831  ENDIF
5832  ELSE
5833  CALL flagerror("Equations set is not associated.",err,error,*999)
5834  ENDIF
5835 
5836  exits("EQUATIONS_SET_SOURCE_CREATE_FINISH")
5837  RETURN
5838 999 errorsexits("EQUATIONS_SET_SOURCE_CREATE_FINISH",err,error)
5839  RETURN 1
5840  END SUBROUTINE equations_set_source_create_finish
5841 
5842  !
5843  !================================================================================================================================
5844  !
5845 
5847  SUBROUTINE equations_set_source_create_start(EQUATIONS_SET,SOURCE_FIELD_USER_NUMBER,SOURCE_FIELD,ERR,ERROR,*)
5848 
5849  !Argument variables
5850  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5851  INTEGER(INTG), INTENT(IN) :: SOURCE_FIELD_USER_NUMBER
5852  TYPE(field_type), POINTER :: SOURCE_FIELD
5853  INTEGER(INTG), INTENT(OUT) :: ERR
5854  TYPE(varying_string), INTENT(OUT) :: ERROR
5855  !Local Variables
5856  INTEGER(INTG) :: DUMMY_ERR
5857  TYPE(equations_set_setup_type) :: EQUATIONS_SET_SETUP_INFO
5858  TYPE(field_type), POINTER :: FIELD,GEOMETRIC_FIELD
5859  TYPE(region_type), POINTER :: REGION,SOURCE_FIELD_REGION
5860  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
5861 
5862  enters("EQUATIONS_SET_SOURCE_CREATE_START",err,error,*998)
5863 
5864  IF(ASSOCIATED(equations_set)) THEN
5865  IF(ASSOCIATED(equations_set%SOURCE)) THEN
5866  CALL flagerror("The equations set source is already associated.",err,error,*998)
5867  ELSE
5868  region=>equations_set%REGION
5869  IF(ASSOCIATED(region)) THEN
5870  IF(ASSOCIATED(source_field)) THEN
5871  !Check the source field has been finished
5872  IF(source_field%FIELD_FINISHED) THEN
5873  !Check the user numbers match
5874  IF(source_field_user_number/=source_field%USER_NUMBER) THEN
5875  local_error="The specified source field user number of "// &
5876  & trim(number_to_vstring(source_field_user_number,"*",err,error))// &
5877  & " does not match the user number of the specified source field of "// &
5878  & trim(number_to_vstring(source_field%USER_NUMBER,"*",err,error))//"."
5879  CALL flagerror(local_error,err,error,*999)
5880  ENDIF
5881  source_field_region=>source_field%REGION
5882  IF(ASSOCIATED(source_field_region)) THEN
5883  !Check the field is defined on the same region as the equations set
5884  IF(source_field_region%USER_NUMBER/=region%USER_NUMBER) THEN
5885  local_error="Invalid region setup. The specified source field has been created on region number "// &
5886  & trim(number_to_vstring(source_field_region%USER_NUMBER,"*",err,error))// &
5887  & " and the specified equations set has been created on region number "// &
5888  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
5889  CALL flagerror(local_error,err,error,*999)
5890  ENDIF
5891  !Check the specified source field has the same decomposition as the geometric field
5892  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
5893  IF(ASSOCIATED(geometric_field)) THEN
5894  IF(.NOT.ASSOCIATED(geometric_field%DECOMPOSITION,source_field%DECOMPOSITION)) THEN
5895  CALL flagerror("The specified source field does not have the same decomposition as the geometric "// &
5896  & "field for the specified equations set.",err,error,*999)
5897  ENDIF
5898  ELSE
5899  CALL flagerror("The geometric field is not associated for the specified equations set.",err,error,*999)
5900  ENDIF
5901  ELSE
5902  CALL flagerror("The specified source field region is not associated.",err,error,*999)
5903  ENDIF
5904  ELSE
5905  CALL flagerror("The specified source field has not been finished.",err,error,*999)
5906  ENDIF
5907  ELSE
5908  !Check the user number has not already been used for a field in this region.
5909  NULLIFY(field)
5910  CALL field_user_number_find(source_field_user_number,region,field,err,error,*999)
5911  IF(ASSOCIATED(field)) THEN
5912  local_error="The specified source field user number of "// &
5913  & trim(number_to_vstring(source_field_user_number,"*",err,error))// &
5914  & "has already been used to create a field on region number "// &
5915  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
5916  CALL flagerror(local_error,err,error,*999)
5917  ENDIF
5918  ENDIF
5919  !Initialise the equations set source
5920  CALL equations_set_source_initialise(equations_set,err,error,*999)
5921  IF(.NOT.ASSOCIATED(source_field)) equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED=.true.
5922  !Initialise the setup
5923  CALL equations_set_setup_initialise(equations_set_setup_info,err,error,*999)
5924  equations_set_setup_info%SETUP_TYPE=equations_set_setup_source_type
5925  equations_set_setup_info%ACTION_TYPE=equations_set_setup_start_action
5926  equations_set_setup_info%FIELD_USER_NUMBER=source_field_user_number
5927  equations_set_setup_info%FIELD=>source_field
5928  !Start the equation set specific source setup
5929  CALL equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
5930  !Finalise the setup
5931  CALL equations_set_setup_finalise(equations_set_setup_info,err,error,*999)
5932  !Set pointers
5933  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
5934  source_field=>equations_set%SOURCE%SOURCE_FIELD
5935  ELSE
5936  equations_set%SOURCE%SOURCE_FIELD=>source_field
5937  ENDIF
5938  ELSE
5939  CALL flagerror("Equation set region is not associated.",err,error,*999)
5940  ENDIF
5941  ENDIF
5942  ELSE
5943  CALL flagerror("Equations set is not associated.",err,error,*998)
5944  ENDIF
5945 
5946  exits("EQUATIONS_SET_SOURCE_CREATE_START")
5947  RETURN
5948 999 CALL equations_set_source_finalise(equations_set%SOURCE,dummy_err,dummy_error,*998)
5949 998 errorsexits("EQUATIONS_SET_SOURCE_CREATE_START",err,error)
5950  RETURN 1
5951  END SUBROUTINE equations_set_source_create_start
5952 
5953  !
5954  !================================================================================================================================
5955  !
5956 
5958  SUBROUTINE equations_set_source_destroy(EQUATIONS_SET,ERR,ERROR,*)
5959 
5960  !Argument variables
5961  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5962  INTEGER(INTG), INTENT(OUT) :: ERR
5963  TYPE(varying_string), INTENT(OUT) :: ERROR
5964  !Local Variables
5965 
5966  enters("EQUATIONS_SET_SOURCE_DESTROY",err,error,*999)
5967 
5968  IF(ASSOCIATED(equations_set)) THEN
5969  IF(ASSOCIATED(equations_set%SOURCE)) THEN
5970  CALL equations_set_source_finalise(equations_set%SOURCE,err,error,*999)
5971  ELSE
5972  CALL flagerror("Equations set source is not associated.",err,error,*999)
5973  ENDIF
5974  ELSE
5975  CALL flagerror("Equations set is not associated",err,error,*999)
5976  ENDIF
5977 
5978  exits("EQUATIONS_SET_SOURCE_DESTROY")
5979  RETURN
5980 999 errorsexits("EQUATIONS_SET_SOURCE_DESTROY",err,error)
5981  RETURN 1
5982  END SUBROUTINE equations_set_source_destroy
5983 
5984  !
5985  !================================================================================================================================
5986  !
5987 
5989  SUBROUTINE equations_set_source_finalise(EQUATIONS_SET_SOURCE,ERR,ERROR,*)
5990 
5991  !Argument variables
5992  TYPE(equations_set_source_type), POINTER :: EQUATIONS_SET_SOURCE
5993  INTEGER(INTG), INTENT(OUT) :: ERR
5994  TYPE(varying_string), INTENT(OUT) :: ERROR
5995  !Local Variables
5996 
5997  enters("EQUATIONS_SET_SOURCE_FINALISE",err,error,*999)
5998 
5999  IF(ASSOCIATED(equations_set_source)) THEN
6000  DEALLOCATE(equations_set_source)
6001  ENDIF
6002 
6003  exits("EQUATIONS_SET_SOURCE_FINALISE")
6004  RETURN
6005 999 errorsexits("EQUATIONS_SET_SOURCE_FINALISE",err,error)
6006  RETURN 1
6007  END SUBROUTINE equations_set_source_finalise
6008 
6009  !
6010  !================================================================================================================================
6011  !
6012 
6014  SUBROUTINE equations_set_source_initialise(EQUATIONS_SET,ERR,ERROR,*)
6015 
6016  !Argument variables
6017  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
6018  INTEGER(INTG), INTENT(OUT) :: ERR
6019  TYPE(varying_string), INTENT(OUT) :: ERROR
6020  !Local Variables
6021  INTEGER(INTG) :: DUMMY_ERR
6022  TYPE(varying_string) :: DUMMY_ERROR
6023 
6024  enters("EQUATIONS_SET_SOURCE_INITIALISE",err,error,*998)
6025 
6026  IF(ASSOCIATED(equations_set)) THEN
6027  IF(ASSOCIATED(equations_set%SOURCE)) THEN
6028  CALL flagerror("Source is already associated for this equations set.",err,error,*998)
6029  ELSE
6030  ALLOCATE(equations_set%SOURCE,stat=err)
6031  IF(err/=0) CALL flagerror("Could not allocate equations set source.",err,error,*999)
6032  equations_set%SOURCE%EQUATIONS_SET=>equations_set
6033  equations_set%SOURCE%SOURCE_FINISHED=.false.
6034  equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED=.false.
6035  NULLIFY(equations_set%SOURCE%SOURCE_FIELD)
6036  ENDIF
6037  ELSE
6038  CALL flagerror("Equations set is not associated.",err,error,*998)
6039  ENDIF
6040 
6041  exits("EQUATIONS_SET_SOURCE_INITIALISE")
6042  RETURN
6043 999 CALL equations_set_source_finalise(equations_set%SOURCE,dummy_err,dummy_error,*998)
6044 998 errorsexits("EQUATIONS_SET_SOURCE_INITIALISE",err,error)
6045  RETURN 1
6046 
6047  END SUBROUTINE equations_set_source_initialise
6048 
6049  !
6050  !================================================================================================================================
6051  !
6052 
6054  SUBROUTINE equationsset_specificationget(equationsSet,equationsSetSpecification,err,error,*)
6055 
6056  !Argument variables
6057  TYPE(equations_set_type), POINTER :: equationsSet
6058  INTEGER(INTG), INTENT(INOUT) :: equationsSetSpecification(:)
6059  INTEGER(INTG), INTENT(OUT) :: err
6060  TYPE(varying_string), INTENT(OUT) :: error
6061  !Local Variables
6062  INTEGER(INTG) :: specificationLength,specificationIdx
6063  TYPE(varying_string) :: localError
6064 
6065  enters("EquationsSet_SpecificationGet",err,error,*999)
6066 
6067  IF(ASSOCIATED(equationsset)) THEN
6068  IF(equationsset%equations_set_finished) THEN
6069  specificationlength=0
6070  DO specificationidx=1,SIZE(equationsset%specification,1)
6071  IF(equationsset%specification(specificationidx)>0) THEN
6072  specificationlength=specificationidx
6073  END IF
6074  END DO
6075  IF(SIZE(equationssetspecification,1)>=specificationlength) THEN
6076  equationssetspecification(1:specificationlength)=equationsset%specification(1:specificationlength)
6077  ELSE
6078  localerror="The equations set specification array size is "//trim(numbertovstring(specificationlength,"*",err,error))// &
6079  & " and it needs to be >= "//trim(numbertovstring(SIZE(equationssetspecification,1),"*",err,error))//"."
6080  CALL flagerror(localerror,err,error,*999)
6081  END IF
6082  ELSE
6083  CALL flagerror("Equations set has not been finished.",err,error,*999)
6084  END IF
6085  ELSE
6086  CALL flagerror("Equations set is not associated.",err,error,*999)
6087  END IF
6088 
6089  exits("EquationsSet_SpecificationGet")
6090  RETURN
6091 999 errors("EquationsSet_SpecificationGet",err,error)
6092  exits("EquationsSet_SpecificationGet")
6093  RETURN 1
6094 
6095  END SUBROUTINE equationsset_specificationget
6096 
6097  !
6098  !================================================================================================================================
6099  !
6100 
6102  SUBROUTINE equationsset_specificationsizeget(equationsSet,specificationSize,err,error,*)
6103 
6104  !Argument variables
6105  TYPE(equations_set_type), POINTER :: equationsSet
6106  INTEGER(INTG), INTENT(OUT) :: specificationSize
6107  INTEGER(INTG), INTENT(OUT) :: err
6108  TYPE(varying_string), INTENT(OUT) :: error
6109  !Local Variables
6110 
6111  enters("EquationsSet_SpecificationSizeGet",err,error,*999)
6112 
6113  specificationsize=0
6114  IF(ASSOCIATED(equationsset)) THEN
6115  IF(equationsset%equations_set_finished) THEN
6116  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
6117  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
6118  END IF
6119  specificationsize=SIZE(equationsset%specification,1)
6120  ELSE
6121  CALL flagerror("Equations set has not been finished.",err,error,*999)
6122  ENDIF
6123  ELSE
6124  CALL flagerror("Equations set is not associated.",err,error,*999)
6125  ENDIF
6126 
6127  exits("EquationsSet_SpecificationSizeGet")
6128  RETURN
6129 999 errorsexits("EquationsSet_SpecificationSizeGet",err,error)
6130  RETURN 1
6131 
6132  END SUBROUTINE equationsset_specificationsizeget
6133 
6134  !
6135  !================================================================================================================================
6136  !
6137 
6139  SUBROUTINE equationsset_derivedvariablecalculate(equationsSet,derivedType,err,error,*)
6140 
6141  !Argument variables
6142  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
6143  INTEGER(INTG), INTENT(IN) :: derivedType
6144  INTEGER(INTG), INTENT(OUT) :: err
6145  TYPE(varying_string), INTENT(OUT) :: error
6146 
6147  enters("EquationsSet_DerivedVariableCalculate",err,error,*999)
6148 
6149  IF(ASSOCIATED(equationsset)) THEN
6150  IF(.NOT.equationsset%EQUATIONS_SET_FINISHED) THEN
6151  CALL flagerror("Equations set has not been finished.",err,error,*999)
6152  ELSE
6153  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
6154  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
6155  ELSE IF(SIZE(equationsset%specification,1)<1) THEN
6156  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
6157  END IF
6158  SELECT CASE(equationsset%specification(1))
6159  CASE(equations_set_elasticity_class)
6160  CALL elasticity_equationssetderivedvariablecalculate(equationsset,derivedtype,err,error,*999)
6161  CASE(equations_set_fluid_mechanics_class)
6162  CALL flagerror("Not implemented.",err,error,*999)
6163  CASE(equations_set_electromagnetics_class)
6164  CALL flagerror("Not implemented.",err,error,*999)
6165  CASE(equations_set_classical_field_class)
6166  CALL flagerror("Not implemented.",err,error,*999)
6167  CASE(equations_set_fitting_class)
6168  CALL flagerror("Not implemented.",err,error,*999)
6169  CASE(equations_set_bioelectrics_class)
6170  CALL flagerror("Not implemented.",err,error,*999)
6171  CASE(equations_set_modal_class)
6172  CALL flagerror("Not implemented.",err,error,*999)
6173  CASE(equations_set_multi_physics_class)
6174  CALL flagerror("Not implemented.",err,error,*999)
6175  CASE DEFAULT
6176  CALL flagerror("The first equations set specification of "// &
6177  & trim(number_to_vstring(equationsset%specification(1),"*",err,error))// &
6178  & " is not valid.",err,error,*999)
6179  END SELECT
6180  ENDIF
6181  ELSE
6182  CALL flagerror("Equations set is not associated.",err,error,*999)
6183  ENDIF
6184 
6185  exits("EquationsSet_DerivedVariableCalculate")
6186  RETURN
6187 999 errorsexits("EquationsSet_DerivedVariableCalculate",err,error)
6188  RETURN 1
6189  END SUBROUTINE equationsset_derivedvariablecalculate
6190 
6191  !
6192  !================================================================================================================================
6193  !
6194 
6196  SUBROUTINE equationsset_derivedvariableset(equationsSet,derivedType,fieldVariableType,err,error,*)
6197 
6198  !Argument variables
6199  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
6200  INTEGER(INTG), INTENT(IN) :: derivedType
6201  INTEGER(INTG), INTENT(IN) :: fieldVariableType
6202  INTEGER(INTG), INTENT(OUT) :: err
6203  TYPE(varying_string), INTENT(OUT) :: error
6204 
6205  enters("EquationsSet_DerivedVariableSet",err,error,*999)
6206 
6207  !Check pointers and finished state
6208  IF(ASSOCIATED(equationsset)) THEN
6209  IF(equationsset%EQUATIONS_SET_FINISHED) THEN
6210  IF(ASSOCIATED(equationsset%derived)) THEN
6211  IF(equationsset%derived%derivedFinished) THEN
6212  CALL flagerror("Equations set derived information is already finished.",err,error,*999)
6213  END IF
6214  ELSE
6215  CALL flagerror("Equations set derived information is not associated.",err,error,*999)
6216  END IF
6217  ELSE
6218  CALL flagerror("Equations set has not been finished.",err,error,*999)
6219  END IF
6220  ELSE
6221  CALL flagerror("Equations set is not associated.",err,error,*999)
6222  ENDIF
6223 
6224  IF(derivedtype>0.AND.derivedtype<=equations_set_number_of_derived_types) THEN
6225  IF(fieldvariabletype>0.AND.fieldvariabletype<=field_number_of_variable_types) THEN
6226  IF(equationsset%derived%variableTypes(derivedtype)==0) THEN
6227  equationsset%derived%numberOfVariables=equationsset%derived%numberOfVariables+1
6228  END IF
6229  equationsset%derived%variableTypes(derivedtype)=fieldvariabletype
6230  ELSE
6231  CALL flagerror("The field variable type of "//trim(number_to_vstring(fieldvariabletype,"*",err,error))// &
6232  & " is invalid. It should be between 1 and "//trim(number_to_vstring(field_number_of_variable_types,"*", &
6233  & err,error))//" inclusive.",err,error,*999)
6234  END IF
6235  ELSE
6236  CALL flagerror("The derived variable type of "//trim(number_to_vstring(derivedtype,"*",err,error))// &
6237  & " is invalid. It should be between 1 and "//trim(number_to_vstring(equations_set_number_of_derived_types,"*", &
6238  & err,error))//" inclusive.",err,error,*999)
6239  END IF
6240 
6241  exits("EquationsSet_DerivedVariableSet")
6242  RETURN
6243 999 errorsexits("EquationsSet_DerivedVariableSet",err,error)
6244  RETURN 1
6245  END SUBROUTINE equationsset_derivedvariableset
6246  !
6247  !================================================================================================================================
6248  !
6249 
6251  SUBROUTINE equationsset_specificationset(equationsSet,specification,err,error,*)
6252 
6253  !Argument variables
6254  TYPE(equations_set_type), POINTER :: equationsSet
6255  INTEGER(INTG), INTENT(IN) :: specification(:)
6256  INTEGER(INTG), INTENT(OUT) :: err
6257  TYPE(varying_string), INTENT(OUT) :: error
6258  !Local Variables
6259  TYPE(varying_string) :: localError
6260 
6261  enters("EquationsSet_SpecificationSet",err,error,*999)
6262 
6263  IF(ASSOCIATED(equationsset)) THEN
6264  IF(equationsset%equations_set_finished) THEN
6265  CALL flagerror("Equations set has been finished.",err,error,*999)
6266  ELSE
6267  IF(SIZE(specification,1)<1) THEN
6268  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
6269  END IF
6270  SELECT CASE(specification(1))
6271  CASE(equations_set_elasticity_class)
6272  CALL elasticity_equationssetspecificationset(equationsset,specification,err,error,*999)
6273  CASE(equations_set_fluid_mechanics_class)
6274  CALL fluidmechanics_equationssetspecificationset(equationsset,specification,err,error,*999)
6275  CASE(equations_set_electromagnetics_class)
6276  CALL flagerror("Not implemented.",err,error,*999)
6277  CASE(equations_set_classical_field_class)
6278  CALL classicalfield_equationssetspecificationset(equationsset,specification,err,error,*999)
6279  CASE(equations_set_bioelectrics_class)
6280  IF(SIZE(specification,1)<2) THEN
6281  CALL flagerror("Equations set specification must have at least two entries for a bioelectrics equation class.", &
6282  & err,error,*999)
6283  END IF
6284  IF(specification(2)==equations_set_monodomain_strang_splitting_equation_type) THEN
6285  CALL monodomain_equationssetspecificationset(equationsset,specification,err,error,*999)
6286  ELSE
6287  CALL bioelectric_equationssetspecificationset(equationsset,specification,err,error,*999)
6288  END IF
6289  CASE(equations_set_modal_class)
6290  CALL flagerror("Not implemented.",err,error,*999)
6291  CASE(equations_set_multi_physics_class)
6292  CALL multiphysics_equationssetspecificationset(equationsset,specification,err,error,*999)
6293  CASE(equations_set_fitting_class)
6294  CALL fitting_equationssetspecificationset(equationsset,specification,err,error,*999)
6295  CASE(equations_set_optimisation_class)
6296  CALL flagerror("Not implemented.",err,error,*999)
6297  CASE DEFAULT
6298  localerror="The first equations set specification of "// &
6299  & trim(numbertovstring(specification(1),"*",err,error))//" is not valid."
6300  CALL flagerror(localerror,err,error,*999)
6301  END SELECT
6302  END IF
6303  ELSE
6304  CALL flagerror("Equations set is not associated.",err,error,*999)
6305  END IF
6306 
6307  exits("EquationsSet_SpecificationSet")
6308  RETURN
6309 999 errors("EquationsSet_SpecificationSet",err,error)
6310  exits("EquationsSet_SpecificationSet")
6311  RETURN 1
6312 
6313  END SUBROUTINE equationsset_specificationset
6314 
6315  !
6316  !================================================================================================================================
6317  !
6318 
6320  SUBROUTINE equationsset_tensorinterpolatexi(equationsSet,tensorEvaluateType,userElementNumber,xi,values,err,error,*)
6321 
6322  !Argument variables
6323  TYPE(equations_set_type), POINTER, INTENT(IN) :: equationsSet
6324  INTEGER(INTG), INTENT(IN) :: tensorEvaluateType
6325  INTEGER(INTG), INTENT(IN) :: userElementNumber
6326  REAL(DP), INTENT(IN) :: xi(:)
6327  REAL(DP), INTENT(OUT) :: values(3,3)
6328  INTEGER(INTG), INTENT(OUT) :: err
6329  TYPE(varying_string), INTENT(OUT) :: error
6330 
6331  enters("EquationsSet_TensorInterpolateXi",err,error,*999)
6332 
6333  IF(.NOT.ASSOCIATED(equationsset)) THEN
6334  CALL flagerror("Equations set is not associated.",err,error,*999)
6335  END IF
6336  IF(.NOT.equationsset%equations_set_finished) THEN
6337  CALL flagerror("Equations set has not been finished.",err,error,*999)
6338  END IF
6339  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
6340  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
6341  ELSE IF(SIZE(equationsset%specification,1)<1) THEN
6342  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
6343  END IF
6344 
6345  SELECT CASE(equationsset%specification(1))
6346  CASE(equations_set_elasticity_class)
6347  CALL elasticity_tensorinterpolatexi(equationsset,tensorevaluatetype,userelementnumber,xi,values,err,error,*999)
6348  CASE(equations_set_fluid_mechanics_class)
6349  CALL flagerror("Not implemented.",err,error,*999)
6350  CASE(equations_set_electromagnetics_class)
6351  CALL flagerror("Not implemented.",err,error,*999)
6352  CASE(equations_set_classical_field_class)
6353  CALL flagerror("Not implemented.",err,error,*999)
6354  CASE(equations_set_modal_class)
6355  CALL flagerror("Not implemented.",err,error,*999)
6356  CASE(equations_set_multi_physics_class)
6357  CALL flagerror("Not implemented.",err,error,*999)
6358  CASE(equations_set_fitting_class)
6359  CALL flagerror("Not implemented.",err,error,*999)
6360  CASE(equations_set_optimisation_class)
6361  CALL flagerror("Not implemented.",err,error,*999)
6362  CASE DEFAULT
6363  CALL flagerror("The first equations set specification of "// &
6364  & trim(numbertovstring(equationsset%specification(1),"*",err,error))// &
6365  & " is not valid.",err,error,*999)
6366  END SELECT
6367 
6368  exits("EquationsSet_TensorInterpolateXi")
6369  RETURN
6370 999 errorsexits("EquationsSet_TensorInterpolateXi",err,error)
6371  RETURN 1
6372 
6373  END SUBROUTINE equationsset_tensorinterpolatexi
6374 
6375  !
6376  !================================================================================================================================
6377  !
6378 
6380  SUBROUTINE equations_set_user_number_find(USER_NUMBER,REGION,EQUATIONS_SET,ERR,ERROR,*)
6381 
6382  !Argument variables
6383  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
6384  TYPE(region_type), POINTER :: REGION
6385  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
6386  INTEGER(INTG), INTENT(OUT) :: ERR
6387  TYPE(varying_string), INTENT(OUT) :: ERROR
6388  !Local Variables
6389  INTEGER(INTG) :: equations_set_idx
6390  TYPE(varying_string) :: LOCAL_ERROR
6391 
6392  enters("EQUATIONS_SET_USER_NUMBER_FIND",err,error,*999)
6393 
6394  IF(ASSOCIATED(region)) THEN
6395  IF(ASSOCIATED(equations_set)) THEN
6396  CALL flagerror("Equations set is already associated.",err,error,*999)
6397  ELSE
6398  NULLIFY(equations_set)
6399  IF(ASSOCIATED(region%EQUATIONS_SETS)) THEN
6400  equations_set_idx=1
6401  DO WHILE(equations_set_idx<=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS.AND..NOT.ASSOCIATED(equations_set))
6402  IF(region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR%USER_NUMBER==user_number) THEN
6403  equations_set=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
6404  ELSE
6405  equations_set_idx=equations_set_idx+1
6406  ENDIF
6407  ENDDO
6408  ELSE
6409  local_error="The equations sets on region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))// &
6410  & " are not associated."
6411  CALL flagerror(local_error,err,error,*999)
6412  ENDIF
6413  ENDIF
6414  ELSE
6415  CALL flagerror("Region is not associated.",err,error,*999)
6416  ENDIF
6417 
6418  exits("EQUATIONS_SET_USER_NUMBER_FIND")
6419  RETURN
6420 999 errorsexits("EQUATIONS_SET_USER_NUMBER_FIND",err,error)
6421  RETURN 1
6422  END SUBROUTINE equations_set_user_number_find
6423 
6424  !
6425  !================================================================================================================================
6426  !
6427 
6429  SUBROUTINE equations_sets_finalise(REGION,ERR,ERROR,*)
6430 
6431  !Argument variables
6432  TYPE(region_type), POINTER :: REGION
6433  INTEGER(INTG), INTENT(OUT) :: ERR
6434  TYPE(varying_string), INTENT(OUT) :: ERROR
6435  !Local Variables
6436 
6437  enters("EQUATIONS_SETS_FINALISE",err,error,*999)
6438 
6439  IF(ASSOCIATED(region)) THEN
6440  IF(ASSOCIATED(region%EQUATIONS_SETS)) THEN
6441  DO WHILE(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS>0)
6442  CALL equations_set_destroy(region%EQUATIONS_SETS%EQUATIONS_SETS(1)%PTR,err,error,*999)
6443  ENDDO !problem_idx
6444  DEALLOCATE(region%EQUATIONS_SETS)
6445  ENDIF
6446  ELSE
6447  CALL flagerror("Region is not associated.",err,error,*999)
6448  ENDIF
6449 
6450  exits("EQUATIONS_SETS_FINALISE")
6451  RETURN
6452 999 errorsexits("EQUATIONS_SETS_FINALISE",err,error)
6453  RETURN 1
6454  END SUBROUTINE equations_sets_finalise
6455 
6456  !
6457  !================================================================================================================================
6458  !
6459 
6461  SUBROUTINE equations_sets_initialise(REGION,ERR,ERROR,*)
6462 
6463  !Argument variables
6464  TYPE(region_type), POINTER :: REGION
6465  INTEGER(INTG), INTENT(OUT) :: ERR
6466  TYPE(varying_string), INTENT(OUT) :: ERROR
6467  !Local Variables
6468 
6469  enters("EQUATIONS_SETS_INITIALISE",err,error,*999)
6470 
6471  IF(ASSOCIATED(region)) THEN
6472  IF(ASSOCIATED(region%EQUATIONS_SETS)) THEN
6473  CALL flagerror("Region already has associated equations sets",err,error,*998)
6474  ELSE
6475 !!TODO: Inherit any equations sets from the parent region???
6476  ALLOCATE(region%EQUATIONS_SETS,stat=err)
6477  IF(err/=0) CALL flagerror("Could not allocate region equations sets",err,error,*999)
6478  region%EQUATIONS_SETS%REGION=>region
6479  region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=0
6480  NULLIFY(region%EQUATIONS_SETS%EQUATIONS_SETS)
6481  ENDIF
6482  ELSE
6483  CALL flagerror("Region is not associated.",err,error,*998)
6484  ENDIF
6485 
6486  exits("EQUATIONS_SETS_INITIALISE")
6487  RETURN
6488 999 IF(ASSOCIATED(region%EQUATIONS_SETS)) DEALLOCATE(region%EQUATIONS_SETS)
6489 998 errorsexits("EQUATIONS_SETS_INITIALISE",err,error)
6490  RETURN 1
6491  END SUBROUTINE equations_sets_initialise
6492 
6493  !
6494  !================================================================================================================================
6495  !
6496 
6498  SUBROUTINE equations_set_boundary_conditions_increment(EQUATIONS_SET,BOUNDARY_CONDITIONS,ITERATION_NUMBER, &
6499  & maximum_number_of_iterations,err,error,*)
6500 
6501  !Argument variables
6502  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
6503  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
6504  INTEGER(INTG), INTENT(IN) :: ITERATION_NUMBER
6505  INTEGER(INTG), INTENT(IN) :: MAXIMUM_NUMBER_OF_ITERATIONS
6506  INTEGER(INTG), INTENT(OUT) :: ERR
6507  TYPE(varying_string), INTENT(OUT) :: ERROR
6508 
6509  !Local variables
6510  TYPE(field_type), POINTER :: DEPENDENT_FIELD
6511  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE
6512  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
6513  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
6514  TYPE(boundary_conditions_dirichlet_type), POINTER :: DIRICHLET_BOUNDARY_CONDITIONS
6515  TYPE(boundary_conditions_pressure_incremented_type), POINTER :: PRESSURE_INCREMENTED_BOUNDARY_CONDITIONS
6516  INTEGER(INTG) :: variable_idx,variable_type,dirichlet_idx,dirichlet_dof_idx,neumann_point_dof
6517  INTEGER(INTG) :: condition_idx, condition_global_dof, condition_local_dof, MY_COMPUTATIONAL_NODE_NUMBER
6518  REAL(DP), POINTER :: FULL_LOADS(:),CURRENT_LOADS(:), PREV_LOADS(:)
6519  REAL(DP) :: FULL_LOAD, CURRENT_LOAD, NEW_LOAD, PREV_LOAD
6520  TYPE(varying_string) :: LOCAL_ERROR
6521 
6522  enters("EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT",err,error,*999)
6523 
6524  NULLIFY(dependent_field)
6525  NULLIFY(dependent_variable)
6526  NULLIFY(boundary_conditions_variable)
6527  NULLIFY(dirichlet_boundary_conditions)
6528  NULLIFY(full_loads)
6529  NULLIFY(prev_loads)
6530  NULLIFY(current_loads)
6531 
6532  my_computational_node_number=computational_node_number_get(err,error)
6533 
6534  !Take the stored load, scale it down appropriately then apply to the unknown variables
6535  IF(ASSOCIATED(equations_set)) THEN
6536  IF(diagnostics1) THEN
6537  CALL write_string_value(diagnostic_output_type," equations set",equations_set%USER_NUMBER,err,error,*999)
6538  ENDIF
6539  IF(ASSOCIATED(boundary_conditions)) THEN
6540  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6541  IF(ASSOCIATED(dependent_field)) THEN
6542  IF(ALLOCATED(dependent_field%VARIABLES)) THEN
6543  !Loop over the variables associated with this equations set
6544  !\todo: Looping over all field variables is not safe when volume-coupled problem is solved. Look at matrix and rhs mapping instead?
6545  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
6546  dependent_variable=>dependent_field%VARIABLES(variable_idx)
6547  variable_type=dependent_variable%VARIABLE_TYPE
6548  CALL boundary_conditions_variable_get(boundary_conditions,dependent_variable,boundary_conditions_variable, &
6549  & err,error,*999)
6550  IF(ASSOCIATED(boundary_conditions_variable)) THEN
6551  domain_mapping=>dependent_variable%DOMAIN_MAPPING
6552  IF(ASSOCIATED(domain_mapping)) THEN
6553 
6554  ! Check if there are any incremented conditions applied for this boundary conditions variable
6555  IF(boundary_conditions_variable%DOF_COUNTS(boundary_condition_fixed_incremented)>0.OR. &
6556  & boundary_conditions_variable%DOF_COUNTS(boundary_condition_moved_wall_incremented)>0) THEN
6557  IF(ASSOCIATED(boundary_conditions_variable%DIRICHLET_BOUNDARY_CONDITIONS)) THEN
6558  dirichlet_boundary_conditions=>boundary_conditions_variable%DIRICHLET_BOUNDARY_CONDITIONS
6559  !Get the pointer to vector holding the full and current loads
6560  ! full load: FIELD_BOUNDARY_CONDITIONS_SET_TYPE - holds the target load values
6561  ! current load: FIELD_VALUES_SET_TYPE - holds the current increment values
6562  CALL field_parametersetdataget(dependent_field,variable_type,field_boundary_conditions_set_type, &
6563  & full_loads,err,error,*999)
6564  !chrm 22/06/2010: 'FIELD_BOUNDARY_CONDITIONS_SET_TYPE' does not get updated with time (update_BCs)
6565  !\ToDo: How can this be achieved ???
6566  ! write(*,*)'FULL_LOADS = ',FULL_LOADS
6567  CALL field_parametersetdataget(dependent_field,variable_type,field_values_set_type, &
6568  & current_loads,err,error,*999)
6569  ! write(*,*)'CURRENT_LOADS = ',CURRENT_LOADS
6570  !Get full increment, calculate new load, then apply to dependent field
6571  DO dirichlet_idx=1,boundary_conditions_variable%NUMBER_OF_DIRICHLET_CONDITIONS
6572  dirichlet_dof_idx=dirichlet_boundary_conditions%DIRICHLET_DOF_INDICES(dirichlet_idx)
6573  !Check whether we have an incremented boundary condition type
6574  SELECT CASE(boundary_conditions_variable%CONDITION_TYPES(dirichlet_dof_idx))
6575  CASE(boundary_condition_fixed_incremented, &
6576  & boundary_condition_moved_wall_incremented)
6577  !Convert dof index to local index
6578  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%DOMAIN_NUMBER(1)== &
6579  & my_computational_node_number) THEN
6580  dirichlet_dof_idx=domain_mapping%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%LOCAL_NUMBER(1)
6581  IF(0<dirichlet_dof_idx.AND.dirichlet_dof_idx<domain_mapping%GHOST_START) THEN
6582  full_load=full_loads(dirichlet_dof_idx)
6583  ! Apply full load if last step, or fixed BC
6584  IF(iteration_number==maximum_number_of_iterations) THEN
6585  CALL field_parametersetupdatelocaldof(dependent_field,variable_type,field_values_set_type, &
6586  & dirichlet_dof_idx,full_load,err,error,*999)
6587  ELSE
6588  !Calculate new load and apply to dependent field
6589  current_load=current_loads(dirichlet_dof_idx)
6590  new_load=current_load+(full_load-current_load)/(maximum_number_of_iterations-iteration_number+1)
6591  CALL field_parametersetupdatelocaldof(dependent_field,variable_type,field_values_set_type, &
6592  & dirichlet_dof_idx,new_load,err,error,*999)
6593  IF(diagnostics1) THEN
6594  CALL write_string_value(diagnostic_output_type," dof idx",dirichlet_dof_idx,err,error,*999)
6595  CALL write_string_value(diagnostic_output_type," current load",current_load,err,error,*999)
6596  CALL write_string_value(diagnostic_output_type," new load",new_load,err,error,*999)
6597  ENDIF
6598  ENDIF !Full or intermediate load
6599  ENDIF !non-ghost dof
6600  ENDIF !current domain
6601  CASE DEFAULT
6602  !Do nothing for non-incremented boundary conditions
6603  END SELECT
6604  ENDDO !dirichlet_idx
6605  !---tob
6606  !\ToDo: What happens if the call below is issued
6607  !without actually that the dependent field has been modified in above conditional ?
6608  CALL field_parametersetupdatestart(dependent_field, &
6609  & variable_type, field_values_set_type,err,error,*999)
6610  CALL field_parametersetupdatefinish(dependent_field, &
6611  & variable_type, field_values_set_type,err,error,*999)
6612  !---toe
6613  !Restore the vector handles
6614  CALL field_parametersetdatarestore(dependent_field,variable_type,field_boundary_conditions_set_type, &
6615  & full_loads,err,error,*999)
6616  CALL field_parametersetdatarestore(dependent_field,variable_type,field_values_set_type, &
6617  & current_loads,err,error,*999)
6618  ELSE
6619  local_error="Dirichlet boundary condition for variable type "// &
6620  & trim(number_to_vstring(variable_type,"*",err,error))//" is not associated."
6621  CALL flagerror(local_error,err,error,*999)
6622  ENDIF
6623  ENDIF
6624 
6625  ! Also increment any incremented Neumann point conditions
6626  IF(boundary_conditions_variable%DOF_COUNTS(boundary_condition_neumann_point_incremented)>0) THEN
6627  IF(ASSOCIATED(boundary_conditions_variable%neumannBoundaryConditions)) THEN
6628  ! The boundary conditions parameter set contains the full values and the
6629  ! current incremented values are transferred to the point values vector
6630  DO condition_idx=1,boundary_conditions_variable%DOF_COUNTS(boundary_condition_neumann_point_incremented)+ &
6631  & boundary_conditions_variable%DOF_COUNTS(boundary_condition_neumann_point)
6632  condition_global_dof=boundary_conditions_variable%neumannBoundaryConditions%setDofs(condition_idx)
6633  ! condition_global_dof could be for non-incremented point Neumann condition
6634  IF(boundary_conditions_variable%CONDITION_TYPES(condition_global_dof)/= &
6635  & boundary_condition_neumann_point_incremented) cycle
6636  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)%DOMAIN_NUMBER(1)== &
6637  & my_computational_node_number) THEN
6638  condition_local_dof=domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)% &
6639  & local_number(1)
6640  neumann_point_dof=boundary_conditions_variable%neumannBoundaryConditions%pointDofMapping% &
6641  & global_to_local_map(condition_idx)%LOCAL_NUMBER(1)
6642  CALL field_parameter_set_get_local_dof(dependent_field,variable_type, &
6643  & field_boundary_conditions_set_type,condition_local_dof,full_load,err,error,*999)
6644  CALL distributed_vector_values_set(boundary_conditions_variable%neumannBoundaryConditions% &
6645  & pointvalues,neumann_point_dof,full_load*(REAL(iteration_number)/REAL(maximum_number_of_iterations)), &
6646  & ERR,ERROR,*999)
6647  END IF
6648  END DO
6649  ELSE
6650  local_error="Neumann boundary conditions for variable type "// &
6651  & trim(number_to_vstring(variable_type,"*",err,error))//" are not associated even though"// &
6652  & trim(number_to_vstring(boundary_conditions_variable%DOF_COUNTS( &
6653  & boundary_condition_neumann_point_incremented), &
6654  & '*',err,error))//" conditions of this type has been counted."
6655  CALL flagerror(local_error,err,error,*999)
6656  END IF
6657  END IF
6658 
6659  !There might also be pressure incremented conditions
6660  IF (boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure_incremented)>0) THEN
6661  ! handle pressure incremented boundary conditions
6662  IF(ASSOCIATED(boundary_conditions_variable%PRESSURE_INCREMENTED_BOUNDARY_CONDITIONS)) THEN
6663  pressure_incremented_boundary_conditions=>boundary_conditions_variable% &
6664  & pressure_incremented_boundary_conditions
6665  !Due to a variety of reasons, the pressure incremented type is setup differently to dirichlet conditions.
6666  !We store two sets of vectors, the current and previous values
6667  ! current: FIELD_PRESSURE_VALUES_SET_TYPE - always holds the current increment, even if not incremented
6668  ! previous: FIELD_PREVIOUS_PRESSURE_SET_TYPE - holds the previously applied increment
6669  !Grab the pointers for both
6670  CALL field_parametersetdataget(dependent_field,variable_type,field_previous_pressure_set_type, &
6671  & prev_loads,err,error,*999)
6672  CALL field_parametersetdataget(dependent_field,variable_type,field_pressure_values_set_type, &
6673  & current_loads,err,error,*999)
6674  !Calculate the new load, update the old load
6675  IF(iteration_number==1) THEN
6676  !On the first iteration, FIELD_PRESSURE_VALUES_SET_TYPE actually contains the full load
6677  DO condition_idx=1,boundary_conditions_variable%DOF_COUNTS( &
6678  & boundary_condition_pressure_incremented)
6679  !Global dof index
6680  condition_global_dof=pressure_incremented_boundary_conditions%PRESSURE_INCREMENTED_DOF_INDICES &
6681  & (condition_idx)
6682  !Must convert into local dof index
6683  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)%DOMAIN_NUMBER(1)== &
6684  & my_computational_node_number) THEN
6685  condition_local_dof=domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)% &
6686  & local_number(1)
6687  IF(0<condition_local_dof.AND.condition_local_dof<domain_mapping%GHOST_START) THEN
6688  new_load=current_loads(condition_local_dof)
6689  new_load=new_load/maximum_number_of_iterations
6690 !if (condition_idx==1) write(*,*) "new load=",new_load
6691  !Update current and previous loads
6692  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
6693  & field_pressure_values_set_type,condition_local_dof,new_load,err,error,*999)
6694  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
6695  & field_previous_pressure_set_type,condition_local_dof,0.0_dp,err,error,*999)
6696  IF(diagnostics1) THEN
6697  CALL write_string_value(diagnostic_output_type," dof idx", &
6698  & condition_local_dof,err,error,*999)
6699  CALL write_string_value(diagnostic_output_type," current load", &
6700  & current_loads(condition_local_dof),err,error,*999)
6701  CALL write_string_value(diagnostic_output_type," new load",new_load,err,error,*999)
6702  ENDIF
6703  ENDIF !Non-ghost dof
6704  ENDIF !Current domain
6705  ENDDO !condition_idx
6706  ELSE
6707  !Calculate the new load, keep the current load
6708  DO condition_idx=1,boundary_conditions_variable%DOF_COUNTS( &
6709  & boundary_condition_pressure_incremented)
6710  !This is global dof idx
6711  condition_global_dof=pressure_incremented_boundary_conditions%PRESSURE_INCREMENTED_DOF_INDICES &
6712  & (condition_idx)
6713  !Must convert into local dof index
6714  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)%DOMAIN_NUMBER(1)== &
6715  & my_computational_node_number) THEN
6716  condition_local_dof=domain_mapping%GLOBAL_TO_LOCAL_MAP(condition_global_dof)% &
6717  & local_number(1)
6718  IF(0<condition_local_dof.AND.condition_local_dof<domain_mapping%GHOST_START) THEN
6719  prev_load=prev_loads(condition_local_dof)
6720  current_load=current_loads(condition_local_dof)
6721  new_load=current_load+(current_load-prev_load) !This may be subject to numerical errors...
6722 !if (condition_idx==1) write(*,*) "new load=",new_load
6723  !Update current and previous loads
6724  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
6725  & field_pressure_values_set_type,condition_local_dof,new_load,err,error,*999)
6726  CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
6727  & field_previous_pressure_set_type,condition_local_dof,current_load,err,error,*999)
6728  IF(diagnostics1) THEN
6729  CALL write_string_value(diagnostic_output_type," dof idx", &
6730  & condition_local_dof,err,error,*999)
6731  CALL write_string_value(diagnostic_output_type," current load", &
6732  & current_loads(condition_local_dof),err,error,*999)
6733  CALL write_string_value(diagnostic_output_type," new load",new_load,err,error,*999)
6734  ENDIF
6735  ENDIF !Non-ghost dof
6736  ENDIF !Current domain
6737  ENDDO !condition_idx
6738  ENDIF
6739  !Start transfer of dofs to neighbouring domains
6740  CALL field_parametersetupdatestart(dependent_field,variable_type,field_previous_pressure_set_type, &
6741  & err,error,*999)
6742  CALL field_parametersetupdatestart(dependent_field,variable_type,field_pressure_values_set_type, &
6743  & err,error,*999)
6744  !Restore the vector handles
6745  CALL field_parametersetdatarestore(dependent_field,variable_type,field_previous_pressure_set_type, &
6746  & prev_loads,err,error,*999)
6747  CALL field_parametersetdatarestore(dependent_field,variable_type,field_pressure_values_set_type, &
6748  & current_loads,err,error,*999)
6749  !Finish transfer of dofs to neighbouring domains
6750  CALL field_parametersetupdatefinish(dependent_field,variable_type,field_previous_pressure_set_type, &
6751  & err,error,*999)
6752  CALL field_parametersetupdatefinish(dependent_field,variable_type,field_pressure_values_set_type, &
6753  & err,error,*999)
6754  ELSE
6755  local_error="Pressure incremented boundary condition for variable type "// &
6756  & trim(number_to_vstring(variable_type,"*",err,error))//" is not associated even though"// &
6757  & trim(number_to_vstring(boundary_conditions_variable%DOF_COUNTS(boundary_condition_pressure_incremented), &
6758  & '*',err,error))//" conditions of this type has been counted."
6759  CALL flagerror(local_error,err,error,*999)
6760  ENDIF
6761  ENDIF !Pressure incremented bc block
6762  ELSE
6763  local_error="Domain mapping is not associated for variable "// &
6764  & trim(number_to_vstring(variable_type,"*",err,error))//" of dependent field"
6765  CALL flagerror(local_error,err,error,*999)
6766  ENDIF !Domain mapping test
6767  ELSE
6768  ! do nothing - no boundary conditions variable type associated?
6769  ENDIF
6770  ENDDO !variable_idx
6771  ELSE
6772  CALL flagerror("Dependent field variables are not allocated.",err,error,*999)
6773  ENDIF
6774  ELSE
6775  CALL flagerror("Dependent field is not associated.",err,error,*999)
6776  ENDIF
6777  ELSE
6778  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
6779  ENDIF
6780  ELSE
6781  CALL flagerror("Equations set is not associated.",err,error,*999)
6782  ENDIF
6783 
6784  exits("EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT")
6785  RETURN
6786 999 errorsexits("EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT",err,error)
6787  RETURN 1
6788 
6789  END SUBROUTINE equations_set_boundary_conditions_increment
6790 
6791  !
6792  !================================================================================================================================
6793  !
6794 
6796  SUBROUTINE equations_set_load_increment_apply(EQUATIONS_SET,BOUNDARY_CONDITIONS,ITERATION_NUMBER,MAXIMUM_NUMBER_OF_ITERATIONS, &
6797  & err,error,*)
6798 
6799  !Argument variables
6800  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
6801  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
6802  INTEGER(INTG), INTENT(IN) :: ITERATION_NUMBER
6803  INTEGER(INTG), INTENT(IN) :: MAXIMUM_NUMBER_OF_ITERATIONS
6804  INTEGER(INTG), INTENT(OUT) :: ERR
6805  TYPE(varying_string), INTENT(OUT) :: ERROR
6806 
6807  enters("EQUATIONS_SET_LOAD_INCREMENT_APPLY",err,error,*999)
6808 
6809  IF(ASSOCIATED(equations_set)) THEN
6810  !Increment boundary conditions
6811  CALL equations_set_boundary_conditions_increment(equations_set,boundary_conditions,iteration_number, &
6812  & maximum_number_of_iterations,err,error,*999)
6813 
6814  !Apply any other equation set specific increments
6815  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
6816  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
6817  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
6818  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
6819  END IF
6820  SELECT CASE(equations_set%SPECIFICATION(1))
6821  CASE(equations_set_elasticity_class)
6822  CALL elasticity_load_increment_apply(equations_set,iteration_number,maximum_number_of_iterations,err,error,*999)
6823  CASE DEFAULT
6824  !Do nothing
6825  END SELECT
6826  ELSE
6827  CALL flagerror("Equations set is not associated.",err,error,*999)
6828  ENDIF
6829 
6830 
6831  exits("EQUATIONS_SET_LOAD_INCREMENT_APPLY")
6832  RETURN
6833 999 errorsexits("EQUATIONS_SET_LOAD_INCREMENT_APPLY",err,error)
6834  RETURN 1
6835 
6836  END SUBROUTINE equations_set_load_increment_apply
6837 
6838  !
6839  !================================================================================================================================
6840  !
6841 
6843  SUBROUTINE equationsset_assemblestaticnonlinearnodal(equationsSet,err,error,*)
6844 
6845  !Argument variables
6846  TYPE(equations_set_type), POINTER :: equationsSet
6847  INTEGER(INTG), INTENT(OUT) :: err
6848  TYPE(varying_string), INTENT(OUT) :: error
6849  !Local Variables
6850  INTEGER(INTG) :: numberOfTimes
6851  INTEGER(INTG) :: nodeIdx,nodeNumber
6852  REAL(SP) :: nodeUserElapsed,nodeSystemElapsed,userElapsed,userTime1(1),userTime2(1),userTime3(1),userTime4(1), &
6853  & userTime5(1),userTime6(1),systemElapsed,systemTime1(1),systemTime2(1),systemTime3(1),systemTime4(1), &
6854  & systemTime5(1),systemTime6(1)
6855  TYPE(domain_mapping_type), POINTER :: nodalMapping
6856  TYPE(equations_type), POINTER :: equations
6857  TYPE(equations_matrices_type), POINTER :: equationsMatrices
6858  TYPE(field_type), POINTER :: dependentField
6859 
6860  enters("EquationsSet_AssembleStaticNonlinearNodal",err,error,*999)
6861 
6862  IF(ASSOCIATED(equationsset)) THEN
6863  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
6864  IF(ASSOCIATED(dependentfield)) THEN
6865  equations=>equationsset%EQUATIONS
6866  IF(ASSOCIATED(equations)) THEN
6867  equationsmatrices=>equations%EQUATIONS_MATRICES
6868  IF(ASSOCIATED(equationsmatrices)) THEN
6869  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6870  CALL cpu_timer(user_cpu,usertime1,err,error,*999)
6871  CALL cpu_timer(system_cpu,systemtime1,err,error,*999)
6872  ENDIF
6873  !Initialise the matrices and rhs vector
6874  CALL equations_matrices_values_initialise(equationsmatrices,equations_matrices_nonlinear_only,0.0_dp,err,error,*999)
6875  !Allocate the nodal matrices
6876  CALL equationsmatrices_nodalinitialise(equationsmatrices,err,error,*999)
6877  nodalmapping=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
6878  & mappings%NODES
6879  !Output timing information if required
6880  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6881  CALL cpu_timer(user_cpu,usertime2,err,error,*999)
6882  CALL cpu_timer(system_cpu,systemtime2,err,error,*999)
6883  userelapsed=usertime2(1)-usertime1(1)
6884  systemelapsed=systemtime2(1)-systemtime1(1)
6885  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",userelapsed, &
6886  & err,error,*999)
6887  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",systemelapsed, &
6888  & err,error,*999)
6889  nodeuserelapsed=0.0_sp
6890  nodesystemelapsed=0.0_sp
6891  ENDIF
6892  numberoftimes=0
6893  !Loop over the internal nodes
6894  DO nodeidx=nodalmapping%INTERNAL_START,nodalmapping%INTERNAL_FINISH
6895  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
6896  numberoftimes=numberoftimes+1
6897  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
6898  CALL equationsset_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
6899  CALL equationsmatrices_nodeadd(equationsmatrices,err,error,*999)
6900  ENDDO !nodeIdx
6901  !Output timing information if required
6902  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6903  CALL cpu_timer(user_cpu,usertime3,err,error,*999)
6904  CALL cpu_timer(system_cpu,systemtime3,err,error,*999)
6905  userelapsed=usertime3(1)-usertime2(1)
6906  systemelapsed=systemtime3(1)-systemtime2(1)
6907  nodeuserelapsed=userelapsed
6908  nodesystemelapsed=systemelapsed
6909  CALL write_string(general_output_type,"",err,error,*999)
6910  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",userelapsed, &
6911  & err,error,*999)
6912  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",systemelapsed, &
6913  & err,error,*999)
6914  ENDIF
6915  !Output timing information if required
6916  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6917  CALL cpu_timer(user_cpu,usertime4,err,error,*999)
6918  CALL cpu_timer(system_cpu,systemtime4,err,error,*999)
6919  userelapsed=usertime4(1)-usertime3(1)
6920  systemelapsed=systemtime4(1)-systemtime3(1)
6921  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",userelapsed, &
6922  & err,error,*999)
6923  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",systemelapsed, &
6924  & err,error,*999)
6925  ENDIF
6926  !Loop over the boundary and ghost nodes
6927  DO nodeidx=nodalmapping%BOUNDARY_START,nodalmapping%GHOST_FINISH
6928  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
6929  numberoftimes=numberoftimes+1
6930  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
6931  CALL equationsset_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
6932  CALL equationsmatrices_nodeadd(equationsmatrices,err,error,*999)
6933  ENDDO !nodeIdx
6934  !Output timing information if required
6935  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6936  CALL cpu_timer(user_cpu,usertime5,err,error,*999)
6937  CALL cpu_timer(system_cpu,systemtime5,err,error,*999)
6938  userelapsed=usertime5(1)-usertime4(1)
6939  systemelapsed=systemtime5(1)-systemtime4(1)
6940  nodeuserelapsed=nodeuserelapsed+userelapsed
6941  nodesystemelapsed=nodesystemelapsed+userelapsed
6942  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",userelapsed, &
6943  & err,error,*999)
6944  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",systemelapsed, &
6945  & err,error,*999)
6946  IF(numberoftimes>0) THEN
6947  CALL write_string_value(general_output_type,"Average node user time for equations assembly = ", &
6948  & nodeuserelapsed/numberoftimes,err,error,*999)
6949  CALL write_string_value(general_output_type,"Average node system time for equations assembly = ", &
6950  & nodesystemelapsed/numberoftimes,err,error,*999)
6951  ENDIF
6952  ENDIF
6953  !Finalise the nodal matrices
6954  CALL equationsmatrices_nodalfinalise(equationsmatrices,err,error,*999)
6955  !Output equations matrices and RHS vector if required
6956  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
6957  CALL equations_matrices_output(general_output_type,equationsmatrices,err,error,*999)
6958  ENDIF
6959  !Output timing information if required
6960  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
6961  CALL cpu_timer(user_cpu,usertime6,err,error,*999)
6962  CALL cpu_timer(system_cpu,systemtime6,err,error,*999)
6963  userelapsed=usertime6(1)-usertime1(1)
6964  systemelapsed=systemtime6(1)-systemtime1(1)
6965  CALL write_string(general_output_type,"",err,error,*999)
6966  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",userelapsed, &
6967  & err,error,*999)
6968  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",systemelapsed, &
6969  & err,error,*999)
6970  ENDIF
6971  ELSE
6972  CALL flagerror("Equations matrices is not associated",err,error,*999)
6973  ENDIF
6974  ELSE
6975  CALL flagerror("Equations is not associated",err,error,*999)
6976  ENDIF
6977  ELSE
6978  CALL flagerror("Dependent field is not associated",err,error,*999)
6979  ENDIF
6980  ELSE
6981  CALL flagerror("Equations set is not associated",err,error,*999)
6982  ENDIF
6983 
6984  exits("EquationsSet_AssembleStaticNonlinearNodal")
6985  RETURN
6986 999 errorsexits("EquationsSet_AssembleStaticNonlinearNodal",err,error)
6987  RETURN 1
6988  END SUBROUTINE equationsset_assemblestaticnonlinearnodal
6989 
6990  !
6991  !================================================================================================================================
6992  !
6993 
6995  SUBROUTINE equationsset_nodaljacobianevaluate(equationsSet,nodeNumber,err,error,*)
6996 
6997  !Argument variables
6998  TYPE(equations_set_type), POINTER :: equationsSet
6999  INTEGER(INTG), INTENT(IN) :: nodeNumber
7000  INTEGER(INTG), INTENT(OUT) :: err
7001  TYPE(varying_string), INTENT(OUT) :: error
7002  !Local Variables
7003  INTEGER(INTG) :: matrixIdx
7004  TYPE(nodalmatrixtype), POINTER :: nodalMatrix
7005  TYPE(equations_type), POINTER :: equations
7006  TYPE(equations_matrices_type), POINTER :: equationsMatrices
7007  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
7008  TYPE(varying_string) :: localError
7009 
7010  enters("EquationsSet_NodalJacobianEvaluate",err,error,*999)
7011 
7012  IF(ASSOCIATED(equationsset)) THEN
7013  equations=>equationsset%EQUATIONS
7014  IF(ASSOCIATED(equations)) THEN
7015  equationsmatrices=>equations%EQUATIONS_MATRICES
7016  IF(ASSOCIATED(equationsmatrices)) THEN
7017  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
7018  IF(ASSOCIATED(nonlinearmatrices)) THEN
7019  DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
7020  SELECT CASE(nonlinearmatrices%JACOBIANS(matrixidx)%PTR%JACOBIAN_CALCULATION_TYPE)
7021  CASE(equations_jacobian_analytic_calculated)
7022  ! None of these routines currently support calculating off diagonal terms for coupled problems,
7023  ! but when one does we will have to pass through the matrixIdx parameter
7024  IF(matrixidx>1) THEN
7025  CALL flagerror("Analytic off-diagonal Jacobian calculation not implemented.",err,error,*999)
7026  END IF
7027  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
7028  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
7029  ELSE IF(SIZE(equationsset%specification,1)<1) THEN
7030  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
7031  END IF
7032  SELECT CASE(equationsset%specification(1))
7033  CASE(equations_set_elasticity_class)
7034  CALL flagerror("Not implemented.",err,error,*999)
7035  CASE(equations_set_fluid_mechanics_class)
7036  CALL fluidmechanics_nodaljacobianevaluate(equationsset,nodenumber,err,error,*999)
7037  CASE(equations_set_electromagnetics_class)
7038  CALL flagerror("Not implemented.",err,error,*999)
7039  CASE(equations_set_classical_field_class)
7040  CALL flagerror("Not implemented.",err,error,*999)
7041  CASE(equations_set_bioelectrics_class)
7042  CALL flagerror("Not implemented.",err,error,*999)
7043  CASE(equations_set_modal_class)
7044  CALL flagerror("Not implemented.",err,error,*999)
7045  CASE(equations_set_multi_physics_class)
7046  CALL flagerror("Not implemented.",err,error,*999)
7047  CASE DEFAULT
7048  localerror="The first equations set specification of "// &
7049  & trim(number_to_vstring(equationsset%specification(1),"*", &
7050  & err,error))//" is not valid."
7051  CALL flagerror(localerror,err,error,*999)
7052  END SELECT
7053  CASE(equations_jacobian_finite_difference_calculated)
7054  CALL flagerror("Not implemented.",err,error,*999)
7055  CASE DEFAULT
7056  localerror="Jacobian calculation type "//trim(number_to_vstring(nonlinearmatrices%JACOBIANS(matrixidx)%PTR% &
7057  & jacobian_calculation_type,"*",err,error))//" is not valid."
7058  CALL flagerror(localerror,err,error,*999)
7059  END SELECT
7060  END DO
7061  ELSE
7062  CALL flagerror("Equations nonlinear matrices is not associated.",err,error,*999)
7063  END IF
7064  ELSE
7065  CALL flagerror("Equations matrices is not associated.",err,error,*999)
7066  END IF
7067  IF(equations%OUTPUT_TYPE>=equations_nodal_matrix_output) THEN
7068  CALL write_string(general_output_type,"",err,error,*999)
7069  CALL write_string(general_output_type,"Nodal Jacobian matrix:",err,error,*999)
7070  CALL write_string_value(general_output_type,"Node number = ",nodenumber,err,error,*999)
7071  CALL write_string(general_output_type,"Nodal Jacobian:",err,error,*999)
7072  DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
7073  CALL write_string_value(general_output_type," Jacobian number = ",matrixidx,err,error,*999)
7074  CALL write_string_value(general_output_type," Update Jacobian = ",nonlinearmatrices%JACOBIANS(matrixidx)%PTR% &
7075  & update_jacobian,err,error,*999)
7076  IF(nonlinearmatrices%JACOBIANS(matrixidx)%PTR%UPDATE_JACOBIAN) THEN
7077  nodalmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR%NodalJacobian
7078  CALL write_string_value(general_output_type," Number of rows = ",nodalmatrix%numberOfRows,err,error,*999)
7079  CALL write_string_value(general_output_type," Number of columns = ",nodalmatrix%numberOfColumns, &
7080  & err,error,*999)
7081  CALL write_string_value(general_output_type," Maximum number of rows = ",nodalmatrix%maxNumberOfRows, &
7082  & err,error,*999)
7083  CALL write_string_value(general_output_type," Maximum number of columns = ",nodalmatrix% &
7084  & maxnumberofcolumns,err,error,*999)
7085  CALL write_string_vector(general_output_type,1,1,nodalmatrix%numberOfRows,8,8,nodalmatrix%rowDofs, &
7086  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7087  CALL write_string_vector(general_output_type,1,1,nodalmatrix%numberOfColumns,8,8,nodalmatrix% &
7088  & columndofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7089  CALL write_string_matrix(general_output_type,1,1,nodalmatrix%numberOfRows,1,1,nodalmatrix% &
7090  & numberofcolumns,8,8,nodalmatrix%matrix(1:nodalmatrix%numberOfRows,1:nodalmatrix% &
7091  & numberofcolumns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
7092  & '(16X,8(X,E13.6))',err,error,*999)
7093  END IF
7094  END DO
7095  END IF
7096  ELSE
7097  CALL flagerror("Equations is not associated.",err,error,*999)
7098  END IF
7099  ELSE
7100  CALL flagerror("Equations set is not associated.",err,error,*999)
7101  END IF
7102 
7103  exits("EquationsSet_NodalJacobianEvaluate")
7104  RETURN
7105 999 errorsexits("EquationsSet_NodalJacobianEvaluate",err,error)
7106  RETURN 1
7107 
7108  END SUBROUTINE equationsset_nodaljacobianevaluate
7109 
7110  !
7111  !================================================================================================================================
7112  !
7113 
7115  SUBROUTINE equationsset_nodalresidualevaluate(equationsSet,nodeNumber,err,error,*)
7116 
7117  !Argument variables
7118  TYPE(equations_set_type), POINTER :: equationsSet
7119  INTEGER(INTG), INTENT(IN) :: nodeNumber
7120  INTEGER(INTG), INTENT(OUT) :: err
7121  TYPE(varying_string), INTENT(OUT) :: error
7122  !Local Variables
7123  INTEGER(INTG) :: matrixIdx
7124  TYPE(nodalmatrixtype), POINTER :: nodalMatrix
7125  TYPE(nodalvectortype), POINTER :: nodalVector
7126  TYPE(equations_type), POINTER :: equations
7127  TYPE(equations_matrices_type), POINTER :: equationsMatrices
7128  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
7129  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
7130  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
7131  TYPE(equations_matrices_source_type), POINTER :: sourceVector
7132  TYPE(varying_string) :: localError
7133 
7134  enters("EquationsSet_NodalResidualEvaluate",err,error,*999)
7135 
7136  IF(ASSOCIATED(equationsset)) THEN
7137  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
7138  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
7139  ELSE IF(SIZE(equationsset%specification,1)<1) THEN
7140  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
7141  END IF
7142  SELECT CASE(equationsset%specification(1))
7143  CASE(equations_set_elasticity_class)
7144  CALL flagerror("Not implemented.",err,error,*999)
7145  CASE(equations_set_fluid_mechanics_class)
7146  CALL fluidmechanics_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
7147  CASE(equations_set_electromagnetics_class)
7148  CALL flagerror("Not implemented.",err,error,*999)
7149  CASE(equations_set_classical_field_class)
7150  CALL flagerror("Not implemented.",err,error,*999)
7151  CASE(equations_set_bioelectrics_class)
7152  CALL flagerror("Not implemented.",err,error,*999)
7153  CASE(equations_set_modal_class)
7154  CALL flagerror("Not implemented.",err,error,*999)
7155  CASE(equations_set_multi_physics_class)
7156  CALL flagerror("Not implemented.",err,error,*999)
7157  CASE DEFAULT
7158  localerror="The first equations set specification of "// &
7159  & trim(number_to_vstring(equationsset%specification(1),"*",err,error))//" is not valid."
7160  CALL flagerror(localerror,err,error,*999)
7161  END SELECT
7162  equations=>equationsset%EQUATIONS
7163  IF(ASSOCIATED(equations)) THEN
7164  equationsmatrices=>equations%EQUATIONS_MATRICES
7165  IF(ASSOCIATED(equationsmatrices)) THEN
7166  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
7167  IF(ASSOCIATED(nonlinearmatrices)) THEN
7168  nonlinearmatrices%NodalResidualCalculated=nodenumber
7169  IF(equations%OUTPUT_TYPE>=equations_nodal_matrix_output) THEN
7170  CALL write_string(general_output_type,"",err,error,*999)
7171  CALL write_string(general_output_type,"Nodal residual matrices and vectors:",err,error,*999)
7172  CALL write_string_value(general_output_type,"Node number = ",nodenumber,err,error,*999)
7173  linearmatrices=>equationsmatrices%LINEAR_MATRICES
7174  IF(ASSOCIATED(linearmatrices)) THEN
7175  CALL write_string(general_output_type,"Linear matrices:",err,error,*999)
7176  CALL write_string_value(general_output_type,"Number of node matrices = ",linearmatrices% &
7177  & number_of_linear_matrices,err,error,*999)
7178  DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
7179  CALL write_string_value(general_output_type,"Node matrix : ",matrixidx,err,error,*999)
7180  CALL write_string_value(general_output_type," Update matrix = ",linearmatrices%MATRICES(matrixidx)%PTR% &
7181  & update_matrix,err,error,*999)
7182  IF(linearmatrices%MATRICES(matrixidx)%PTR%UPDATE_MATRIX) THEN
7183  nodalmatrix=>linearmatrices%MATRICES(matrixidx)%PTR%NodalMatrix
7184  CALL write_string_value(general_output_type," Number of rows = ",nodalmatrix%numberOfRows,err,error,*999)
7185  CALL write_string_value(general_output_type," Number of columns = ",nodalmatrix%numberOfColumns, &
7186  & err,error,*999)
7187  CALL write_string_value(general_output_type," Maximum number of rows = ",nodalmatrix%maxNumberOfRows, &
7188  & err,error,*999)
7189  CALL write_string_value(general_output_type," Maximum number of columns = ",nodalmatrix% &
7190  & maxnumberofcolumns,err,error,*999)
7191  CALL write_string_vector(general_output_type,1,1,nodalmatrix%numberOfRows,8,8,nodalmatrix%rowDofs, &
7192  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7193  CALL write_string_vector(general_output_type,1,1,nodalmatrix%numberOfColumns,8,8,nodalmatrix% &
7194  & columndofs,'(" Column dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7195  CALL write_string_matrix(general_output_type,1,1,nodalmatrix%numberOfRows,1,1,nodalmatrix% &
7196  & numberofcolumns,8,8,nodalmatrix%matrix(1:nodalmatrix%numberOfRows,1:nodalmatrix% &
7197  & numberofcolumns),write_string_matrix_name_and_indices,'(" Matrix','(",I2,",:)',' :",8(X,E13.6))', &
7198  & '(16X,8(X,E13.6))',err,error,*999)
7199  ENDIF
7200  ENDDO !matrixIdx
7201  ENDIF
7202  CALL write_string(general_output_type,"Node residual vector:",err,error,*999)
7203  CALL write_string_value(general_output_type," Update vector = ",nonlinearmatrices%UPDATE_RESIDUAL,err,error,*999)
7204  IF(nonlinearmatrices%UPDATE_RESIDUAL) THEN
7205  nodalvector=>nonlinearmatrices%NodalResidual
7206  CALL write_string_value(general_output_type," Number of rows = ",nodalvector%numberOfRows,err,error,*999)
7207  CALL write_string_value(general_output_type," Maximum number of rows = ",nodalvector%maxNumberOfRows, &
7208  & err,error,*999)
7209  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%rowDofs, &
7210  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7211  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%vector, &
7212  & '(" Vector(:) :",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
7213  ENDIF
7214  rhsvector=>equationsmatrices%RHS_VECTOR
7215  IF(ASSOCIATED(rhsvector)) THEN
7216  CALL write_string(general_output_type,"Node RHS vector :",err,error,*999)
7217  CALL write_string_value(general_output_type," Update vector = ",rhsvector%UPDATE_VECTOR,err,error,*999)
7218  IF(rhsvector%UPDATE_VECTOR) THEN
7219  nodalvector=>rhsvector%NodalVector
7220  CALL write_string_value(general_output_type," Number of rows = ",nodalvector%numberOfRows,err,error,*999)
7221  CALL write_string_value(general_output_type," Maximum number of rows = ",nodalvector%maxNumberOfRows, &
7222  & err,error,*999)
7223  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%rowDofs, &
7224  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7225  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%vector, &
7226  & '(" Vector(:) :",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
7227  ENDIF
7228  ENDIF
7229  sourcevector=>equationsmatrices%SOURCE_VECTOR
7230  IF(ASSOCIATED(sourcevector)) THEN
7231  CALL write_string(general_output_type,"Node source vector :",err,error,*999)
7232  CALL write_string_value(general_output_type," Update vector = ",sourcevector%UPDATE_VECTOR,err,error,*999)
7233  IF(sourcevector%UPDATE_VECTOR) THEN
7234  nodalvector=>sourcevector%NodalVector
7235  CALL write_string_value(general_output_type," Number of rows = ",nodalvector%numberOfRows,err,error,*999)
7236  CALL write_string_value(general_output_type," Maximum number of rows = ",nodalvector%maxNumberOfRows, &
7237  & err,error,*999)
7238  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%rowDofs, &
7239  & '(" Row dofs :",8(X,I13))','(16X,8(X,I13))',err,error,*999)
7240  CALL write_string_vector(general_output_type,1,1,nodalvector%numberOfRows,8,8,nodalvector%vector, &
7241  & '(" Vector(:) :",8(X,E13.6))','(16X,8(X,E13.6))',err,error,*999)
7242  ENDIF
7243  ENDIF
7244  ENDIF
7245  ELSE
7246  CALL flagerror("Equation nonlinear matrices not associated.",err,error,*999)
7247  ENDIF
7248  ELSE
7249  CALL flagerror("Equation matrices is not associated.",err,error,*999)
7250  ENDIF
7251  ELSE
7252  CALL flagerror("Equations is not associated.",err,error,*999)
7253  ENDIF
7254  ELSE
7255  CALL flagerror("Equations set is not associated.",err,error,*999)
7256  ENDIF
7257 
7258  exits("EquationsSet_NodalResidualEvaluate")
7259  RETURN
7260 999 errorsexits("EquationsSet_NodalResidualEvaluate",err,error)
7261  RETURN 1
7262 
7263  END SUBROUTINE equationsset_nodalresidualevaluate
7264 
7265 
7266  !
7267  !================================================================================================================================
7268  !
7269 
7271  SUBROUTINE equationsset_jacobianevaluatestaticnodal(equationsSet,err,error,*)
7272 
7273  !Argument variables
7274  TYPE(equations_set_type), POINTER :: equationsSet
7275  INTEGER(INTG), INTENT(OUT) :: err
7276  TYPE(varying_string), INTENT(OUT) :: error
7277  !Local Variables
7278  INTEGER(INTG) :: numberOfTimes
7279  INTEGER(INTG) :: nodeIdx,nodeNumber
7280  REAL(SP) :: nodeUserElapsed,nodeSystemElapsed,userElapsed,userTime1(1),userTime2(1),userTime3(1),userTime4(1), &
7281  & userTime5(1),userTime6(1),systemElapsed,systemTime1(1),systemTime2(1),systemTime3(1),systemTime4(1), &
7282  & systemTime5(1),systemTime6(1)
7283  TYPE(domain_mapping_type), POINTER :: nodalMapping
7284  TYPE(equations_type), POINTER :: equations
7285  TYPE(equations_matrices_type), POINTER :: equationsMatrices
7286  TYPE(field_type), POINTER :: dependentField
7287 
7288  enters("EquationsSet_JacobianEvaluateStaticNodal",err,error,*999)
7289 
7290  IF(ASSOCIATED(equationsset)) THEN
7291  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
7292  IF(ASSOCIATED(dependentfield)) THEN
7293  equations=>equationsset%EQUATIONS
7294  IF(ASSOCIATED(equations)) THEN
7295  equationsmatrices=>equations%EQUATIONS_MATRICES
7296  IF(ASSOCIATED(equationsmatrices)) THEN
7297  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7298  CALL cpu_timer(user_cpu,usertime1,err,error,*999)
7299  CALL cpu_timer(system_cpu,systemtime1,err,error,*999)
7300  ENDIF
7301  !Initialise the matrices and rhs vector
7302  CALL equations_matrices_values_initialise(equationsmatrices,equations_matrices_jacobian_only,0.0_dp,err,error,*999)
7303  !Assemble the nodes
7304  !Allocate the nodal matrices
7305  CALL equationsmatrices_nodalinitialise(equationsmatrices,err,error,*999)
7306  nodalmapping=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
7307  & mappings%NODES
7308  !Output timing information if required
7309  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7310  CALL cpu_timer(user_cpu,usertime2,err,error,*999)
7311  CALL cpu_timer(system_cpu,systemtime2,err,error,*999)
7312  userelapsed=usertime2(1)-usertime1(1)
7313  systemelapsed=systemtime2(1)-systemtime1(1)
7314  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",userelapsed, &
7315  & err,error,*999)
7316  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",systemelapsed, &
7317  & err,error,*999)
7318  nodeuserelapsed=0.0_sp
7319  nodesystemelapsed=0.0_sp
7320  ENDIF
7321  numberoftimes=0
7322  !Loop over the internal nodes
7323  DO nodeidx=nodalmapping%INTERNAL_START,nodalmapping%INTERNAL_FINISH
7324  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
7325  numberoftimes=numberoftimes+1
7326  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
7327  CALL equationsset_nodaljacobianevaluate(equationsset,nodenumber,err,error,*999)
7328  CALL equationsmatrices_jacobiannodeadd(equationsmatrices,err,error,*999)
7329  ENDDO !nodeIdx
7330  !Output timing information if required
7331  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7332  CALL cpu_timer(user_cpu,usertime3,err,error,*999)
7333  CALL cpu_timer(system_cpu,systemtime3,err,error,*999)
7334  userelapsed=usertime3(1)-usertime2(1)
7335  systemelapsed=systemtime3(1)-systemtime2(1)
7336  nodeuserelapsed=userelapsed
7337  nodesystemelapsed=systemelapsed
7338  CALL write_string(general_output_type,"",err,error,*999)
7339  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",userelapsed, &
7340  & err,error,*999)
7341  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",systemelapsed, &
7342  & err,error,*999)
7343  ENDIF
7344  !Output timing information if required
7345  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7346  CALL cpu_timer(user_cpu,usertime4,err,error,*999)
7347  CALL cpu_timer(system_cpu,systemtime4,err,error,*999)
7348  userelapsed=usertime4(1)-usertime3(1)
7349  systemelapsed=systemtime4(1)-systemtime3(1)
7350  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",userelapsed, &
7351  & err,error,*999)
7352  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",systemelapsed, &
7353  & err,error,*999)
7354  ENDIF
7355  !Loop over the boundary and ghost nodes
7356  DO nodeidx=nodalmapping%BOUNDARY_START,nodalmapping%GHOST_FINISH
7357  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
7358  numberoftimes=numberoftimes+1
7359  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
7360  CALL equationsset_nodaljacobianevaluate(equationsset,nodenumber,err,error,*999)
7361  CALL equationsmatrices_jacobiannodeadd(equationsmatrices,err,error,*999)
7362  ENDDO !nodeIdx
7363  !Output timing information if required
7364  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7365  CALL cpu_timer(user_cpu,usertime5,err,error,*999)
7366  CALL cpu_timer(system_cpu,systemtime5,err,error,*999)
7367  userelapsed=usertime5(1)-usertime4(1)
7368  systemelapsed=systemtime5(1)-systemtime4(1)
7369  nodeuserelapsed=nodeuserelapsed+userelapsed
7370  nodesystemelapsed=nodesystemelapsed+userelapsed
7371  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",userelapsed, &
7372  & err,error,*999)
7373  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",systemelapsed, &
7374  & err,error,*999)
7375  IF(numberoftimes>0) THEN
7376  CALL write_string_value(general_output_type,"Average node user time for equations assembly = ", &
7377  & nodeuserelapsed/numberoftimes,err,error,*999)
7378  CALL write_string_value(general_output_type,"Average node system time for equations assembly = ", &
7379  & nodesystemelapsed/numberoftimes,err,error,*999)
7380  ENDIF
7381  ENDIF
7382  !Finalise the nodal matrices
7383  CALL equationsmatrices_nodalfinalise(equationsmatrices,err,error,*999)
7384  !Output equations matrices and RHS vector if required
7385  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
7386  CALL equations_matrices_jacobian_output(general_output_type,equationsmatrices,err,error,*999)
7387  ENDIF
7388  !Output timing information if required
7389  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7390  CALL cpu_timer(user_cpu,usertime6,err,error,*999)
7391  CALL cpu_timer(system_cpu,systemtime6,err,error,*999)
7392  userelapsed=usertime6(1)-usertime1(1)
7393  systemelapsed=systemtime6(1)-systemtime1(1)
7394  CALL write_string(general_output_type,"",err,error,*999)
7395  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",userelapsed, &
7396  & err,error,*999)
7397  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",systemelapsed, &
7398  & err,error,*999)
7399  ENDIF
7400  ELSE
7401  CALL flagerror("Equations matrices is not associated",err,error,*999)
7402  ENDIF
7403  ELSE
7404  CALL flagerror("Equations is not associated",err,error,*999)
7405  ENDIF
7406  ELSE
7407  CALL flagerror("Dependent field is not associated",err,error,*999)
7408  ENDIF
7409  ELSE
7410  CALL flagerror("Equations set is not associated.",err,error,*999)
7411  ENDIF
7412 
7413  exits("EquationsSet_JacobianEvaluateStaticNodal")
7414  RETURN
7415 999 errorsexits("EquationsSet_JacobianEvaluateStaticNodal",err,error)
7416  RETURN 1
7417  END SUBROUTINE equationsset_jacobianevaluatestaticnodal
7418 
7419  !
7420  !================================================================================================================================
7421  !
7422 
7424  SUBROUTINE equationsset_residualevaluatestaticnodal(equationsSet,err,error,*)
7425 
7426  !Argument variables
7427  TYPE(equations_set_type), POINTER :: equationsSet
7428  INTEGER(INTG), INTENT(OUT) :: err
7429  TYPE(varying_string), INTENT(OUT) :: error
7430  !Local Variables
7431  INTEGER(INTG) :: numberOfTimes
7432  INTEGER(INTG) :: nodeIdx,nodeNumber
7433  REAL(SP) :: nodeUserElapsed,nodeSystemElapsed,userElapsed,userTime1(1),userTime2(1),userTime3(1),userTime4(1), &
7434  & userTime5(1),userTime6(1),systemElapsed,systemTime1(1),systemTime2(1),systemTime3(1),systemTime4(1), &
7435  & systemTime5(1),systemTime6(1)
7436  TYPE(domain_mapping_type), POINTER :: nodalMapping
7437  TYPE(equations_type), POINTER :: equations
7438  TYPE(equations_matrices_type), POINTER :: equationsMatrices
7439  TYPE(field_type), POINTER :: dependentField,geometricField
7440 
7441  enters("EquationsSet_ResidualEvaluateStaticNodal",err,error,*999)
7442 
7443  IF(ASSOCIATED(equationsset)) THEN
7444  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
7445  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
7446  IF(ASSOCIATED(dependentfield) .AND. ASSOCIATED(geometricfield)) THEN
7447  equations=>equationsset%EQUATIONS
7448  IF(ASSOCIATED(equations)) THEN
7449  equationsmatrices=>equations%EQUATIONS_MATRICES
7450  IF(ASSOCIATED(equationsmatrices)) THEN
7451  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7452  CALL cpu_timer(user_cpu,usertime1,err,error,*999)
7453  CALL cpu_timer(system_cpu,systemtime1,err,error,*999)
7454  ENDIF
7455  !Initialise the matrices and rhs vector
7456  CALL equations_matrices_values_initialise(equationsmatrices,equations_matrices_nonlinear_only,0.0_dp,err,error,*999)
7457  !Allocate the nodal matrices
7458  CALL equationsmatrices_nodalinitialise(equationsmatrices,err,error,*999)
7459  nodalmapping=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
7460  & mappings%NODES
7461  !Output timing information if required
7462  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7463  CALL cpu_timer(user_cpu,usertime2,err,error,*999)
7464  CALL cpu_timer(system_cpu,systemtime2,err,error,*999)
7465  userelapsed=usertime2(1)-usertime1(1)
7466  systemelapsed=systemtime2(1)-systemtime1(1)
7467  CALL write_string_value(general_output_type,"User time for equations setup and initialisation = ",userelapsed, &
7468  & err,error,*999)
7469  CALL write_string_value(general_output_type,"System time for equations setup and initialisation = ",systemelapsed, &
7470  & err,error,*999)
7471  nodeuserelapsed=0.0_sp
7472  nodesystemelapsed=0.0_sp
7473  ENDIF
7474  numberoftimes=0
7475  !Loop over the internal nodes
7476  DO nodeidx=nodalmapping%INTERNAL_START,nodalmapping%INTERNAL_FINISH
7477  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
7478  numberoftimes=numberoftimes+1
7479  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
7480  CALL equationsset_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
7481  CALL equationsmatrices_nodeadd(equationsmatrices,err,error,*999)
7482  ENDDO !nodeIdx
7483  !Output timing information if required
7484  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7485  CALL cpu_timer(user_cpu,usertime3,err,error,*999)
7486  CALL cpu_timer(system_cpu,systemtime3,err,error,*999)
7487  userelapsed=usertime3(1)-usertime2(1)
7488  systemelapsed=systemtime3(1)-systemtime2(1)
7489  nodeuserelapsed=userelapsed
7490  nodesystemelapsed=systemelapsed
7491  CALL write_string(general_output_type,"",err,error,*999)
7492  CALL write_string_value(general_output_type,"User time for internal equations assembly = ",userelapsed, &
7493  & err,error,*999)
7494  CALL write_string_value(general_output_type,"System time for internal equations assembly = ",systemelapsed, &
7495  & err,error,*999)
7496  ENDIF
7497  !Output timing information if required
7498  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7499  CALL cpu_timer(user_cpu,usertime4,err,error,*999)
7500  CALL cpu_timer(system_cpu,systemtime4,err,error,*999)
7501  userelapsed=usertime4(1)-usertime3(1)
7502  systemelapsed=systemtime4(1)-systemtime3(1)
7503  CALL write_string_value(general_output_type,"User time for parameter transfer completion = ",userelapsed, &
7504  & err,error,*999)
7505  CALL write_string_value(general_output_type,"System time for parameter transfer completion = ",systemelapsed, &
7506  & err,error,*999)
7507  ENDIF
7508  !Loop over the boundary and ghost nodes
7509  DO nodeidx=nodalmapping%BOUNDARY_START,nodalmapping%GHOST_FINISH
7510  nodenumber=nodalmapping%DOMAIN_LIST(nodeidx)
7511  numberoftimes=numberoftimes+1
7512  CALL equationsmatrices_nodalcalculate(equationsmatrices,nodenumber,err,error,*999)
7513  CALL equationsset_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
7514  CALL equationsmatrices_nodeadd(equationsmatrices,err,error,*999)
7515  ENDDO !nodeIdx
7516  !Output timing information if required
7517  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7518  CALL cpu_timer(user_cpu,usertime5,err,error,*999)
7519  CALL cpu_timer(system_cpu,systemtime5,err,error,*999)
7520  userelapsed=usertime5(1)-usertime4(1)
7521  systemelapsed=systemtime5(1)-systemtime4(1)
7522  nodeuserelapsed=nodeuserelapsed+userelapsed
7523  nodesystemelapsed=nodesystemelapsed+userelapsed
7524  CALL write_string_value(general_output_type,"User time for boundary+ghost equations assembly = ",userelapsed, &
7525  & err,error,*999)
7526  CALL write_string_value(general_output_type,"System time for boundary+ghost equations assembly = ",systemelapsed, &
7527  & err,error,*999)
7528  IF(numberoftimes>0) THEN
7529  CALL write_string_value(general_output_type,"Average node user time for equations assembly = ", &
7530  & nodeuserelapsed/numberoftimes,err,error,*999)
7531  CALL write_string_value(general_output_type,"Average node system time for equations assembly = ", &
7532  & nodesystemelapsed/numberoftimes,err,error,*999)
7533  ENDIF
7534  ENDIF
7535  !Finalise the nodal matrices
7536  CALL equationsmatrices_nodalfinalise(equationsmatrices,err,error,*999)
7537  !Output equations matrices and RHS vector if required
7538  IF(equations%OUTPUT_TYPE>=equations_matrix_output) THEN
7539  CALL equations_matrices_output(general_output_type,equationsmatrices,err,error,*999)
7540  ENDIF
7541  !Output timing information if required
7542  IF(equations%OUTPUT_TYPE>=equations_timing_output) THEN
7543  CALL cpu_timer(user_cpu,usertime6,err,error,*999)
7544  CALL cpu_timer(system_cpu,systemtime6,err,error,*999)
7545  userelapsed=usertime6(1)-usertime1(1)
7546  systemelapsed=systemtime6(1)-systemtime1(1)
7547  CALL write_string(general_output_type,"",err,error,*999)
7548  CALL write_string_value(general_output_type,"Total user time for equations assembly = ",userelapsed, &
7549  & err,error,*999)
7550  CALL write_string_value(general_output_type,"Total system time for equations assembly = ",systemelapsed, &
7551  & err,error,*999)
7552  ENDIF
7553  ELSE
7554  CALL flagerror("Equations matrices is not associated",err,error,*999)
7555  ENDIF
7556  ELSE
7557  CALL flagerror("Equations is not associated",err,error,*999)
7558  ENDIF
7559  ELSE
7560  CALL flagerror("Dependent field is not associated",err,error,*999)
7561  ENDIF
7562  ELSE
7563  CALL flagerror("Equations set is not associated.",err,error,*999)
7564  ENDIF
7565 
7566  exits("EquationsSet_ResidualEvaluateStaticNodal")
7567  RETURN
7568 999 errorsexits("EquationsSet_ResidualEvaluateStaticNodal",err,error)
7569  RETURN 1
7570  END SUBROUTINE equationsset_residualevaluatestaticnodal
7571 
7572  !
7573  !================================================================================================================================
7574  !
7575 
7576 END MODULE equations_set_routines
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
distributed_matrix_vector::distributed_vector_data_restore
Definition: distributed_matrix_vector.f90:396
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
equations_matrices_routines::equations_matrices_element_add
subroutine, public equations_matrices_element_add(EQUATIONS_MATRICES, ERR, ERROR,)
Adds the element matrices and rhs vector into the equations matrices and rhs vector.
Definition: equations_matrices_routines.f90:1260
equations_matrices_routines::equations_matrices_nonlinear_only
integer(intg), parameter, public equations_matrices_nonlinear_only
Select only the nonlinear equations matrices and vectors.
Definition: equations_matrices_routines.f90:101
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
equations_set_routines::equationsset_residualevaluatestaticnodal
subroutine equationsset_residualevaluatestaticnodal(equationsSet, err, error,)
Evaluates the residual for an static equations set using the nodal method.
Definition: equations_set_routines.f90:7425
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
types::region_type
Contains information for a region.
Definition: types.f90:3252
constants::no_physical_deriv
integer(intg), parameter no_physical_deriv
No physical derivative i.e., u.
Definition: constants.f90:228
equations_set_routines::equations_set_boundary_conditions_analytic
subroutine, public equations_set_boundary_conditions_analytic(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Set boundary conditions for an equation set according to the analytic equations.
Definition: equations_set_routines.f90:2241
boundary_conditions_routines::boundary_condition_moved_wall_incremented
integer(intg), parameter, public boundary_condition_moved_wall_incremented
The dof is fixed as a boundary condition, to be used with load increment loop.
Definition: boundary_condition_routines.f90:109
multi_physics_routines
This module handles all multi physics class routines.
Definition: multi_physics_routines.f90:46
equations_matrices_routines::equations_matrices_element_calculate
subroutine, public equations_matrices_element_calculate(EQUATIONS_MATRICES, ELEMENT_NUMBER, ERR, ERROR,)
Calculate the positions in the equations matrices and rhs of the element matrices and rhs vector...
Definition: equations_matrices_routines.f90:1403
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
types::equations_sets_type
Definition: types.f90:1966
equations_matrices_routines::equationsmatrices_nodalfinalise
subroutine, public equationsmatrices_nodalfinalise(equationsMatrices, err, error,)
Finalise the nodal calculation information and deallocate all memory.
Definition: equations_matrices_routines.f90:2396
equations_set_routines::equations_set_equations_destroy
subroutine, public equations_set_equations_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the equations for an equations set.
Definition: equations_set_routines.f90:4670
equations_routines::equations_destroy
subroutine, public equations_destroy(EQUATIONS, ERR, ERROR,)
Destroys equations.
Definition: equations_routines.f90:232
elasticity_routines::elasticity_equations_set_setup
subroutine, public elasticity_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the equations set for an elasticity equations set class.
Definition: elasticity_routines.f90:374
equations_set_routines::equations_set_materials_initialise
subroutine equations_set_materials_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the materials for an equations set.
Definition: equations_set_routines.f90:3928
equations_set_routines::equations_set_source_finalise
subroutine equations_set_source_finalise(EQUATIONS_SET_SOURCE, ERR, ERROR,)
Finalise the source for a equations set and deallocate all memory.
Definition: equations_set_routines.f90:5990
equations_set_routines::equationsset_jacobianevaluatestaticnodal
subroutine equationsset_jacobianevaluatestaticnodal(equationsSet, err, error,)
Evaluates the Jacobian for an static equations set using the finite nodal method. ...
Definition: equations_set_routines.f90:7272
types::equations_set_independent_type
Contains information on the independent variables for the equations set.
Definition: types.f90:1907
classical_field_routines::classical_field_finite_element_calculate
subroutine, public classical_field_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for a clasical f...
Definition: classical_field_routines.f90:285
boundary_conditions_routines::boundary_condition_dof_free
integer(intg), parameter, public boundary_condition_dof_free
The dof is free.
Definition: boundary_condition_routines.f90:86
distributed_matrix_vector::distributed_matrix_row_major_storage_type
integer(intg), parameter, public distributed_matrix_row_major_storage_type
Distributed matrix row major storage type.
Definition: distributed_matrix_vector.f90:100
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
elasticity_routines::elasticity_tensorinterpolatexi
subroutine, public elasticity_tensorinterpolatexi(equationsSet, tensorEvaluateType, userElementNumber, xi, values, err, error,)
Evaluate a tensor at a given element xi location.
Definition: elasticity_routines.f90:506
equations_set_routines::equations_set_destroy_number
subroutine equations_set_destroy_number(USER_NUMBER, REGION, ERR, ERROR,)
Destroys an equations set identified by a user number on the give region and deallocates all memory...
Definition: equations_set_routines.f90:2552
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
equations_set_routines::equations_set_jacobian_evaluate_static_fem
subroutine equations_set_jacobian_evaluate_static_fem(EQUATIONS_SET, ERR, ERROR,)
Evaluates the Jacobian for an static equations set using the finite element method.
Definition: equations_set_routines.f90:4885
equations_routines::equations_finalise
subroutine, public equations_finalise(EQUATIONS, ERR, ERROR,)
Finalise the equations and deallocate all memory.
Definition: equations_routines.f90:260
equations_set_routines::equations_set_independent_initialise
subroutine equations_set_independent_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the independent field for an equations set.
Definition: equations_set_routines.f90:3569
equations_set_routines::equations_set_dependent_initialise
subroutine equations_set_dependent_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the dependent variables for a equations set.
Definition: equations_set_routines.f90:4179
elasticity_routines
This module handles all elasticity class routines.
Definition: elasticity_routines.f90:45
equations_set_constants::equations_set_bioelectrics_class
integer(intg), parameter equations_set_bioelectrics_class
Definition: equations_set_constants.f90:58
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
equations_set_routines::equations_set_assemble_dynamic_linear_fem
subroutine equations_set_assemble_dynamic_linear_fem(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations stiffness matrix and rhs for a dynamic linear equations set using the finite ...
Definition: equations_set_routines.f90:1149
equations_set_routines::equations_set_residual_evaluate_dynamic_fem
subroutine equations_set_residual_evaluate_dynamic_fem(EQUATIONS_SET, ERR, ERROR,)
Evaluates the residual for an dynamic equations set using the finite element method.
Definition: equations_set_routines.f90:5332
equations_set_routines::equations_set_analytic_evaluate
subroutine, public equations_set_analytic_evaluate(EQUATIONS_SET, ERR, ERROR,)
Evaluates the current analytic solution for an equations set.
Definition: equations_set_routines.f90:363
fitting_routines::fitting_finite_element_calculate
subroutine, public fitting_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Galerkin projection finite element equations ...
Definition: fitting_routines.f90:426
types::boundary_conditions_pressure_incremented_type
Contains information on dofs associated with pressure incremented conditions.
Definition: types.f90:1816
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
boundary_conditions_routines::boundary_condition_neumann_point_incremented
integer(intg), parameter, public boundary_condition_neumann_point_incremented
A Neumann point boundary condition that is incremented inside a load increment control loop...
Definition: boundary_condition_routines.f90:114
boundary_conditions_routines::boundary_condition_pressure_incremented
integer(intg), parameter, public boundary_condition_pressure_incremented
The dof is a surface pressure boundary condition, to be used with load increment loop.
Definition: boundary_condition_routines.f90:108
distributed_matrix_vector::distributed_matrix_data_get
Definition: distributed_matrix_vector.f90:144
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
types::equations_matrices_source_type
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
fitting_routines::fitting_equations_set_setup
subroutine, public fitting_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Galerkin projection type of a data fitting equations set class.
Definition: fitting_routines.f90:1892
equations_set_routines::equations_set_analytic_time_set
subroutine, public equations_set_analytic_time_set(EQUATIONS_SET, TIME, ERR, ERROR,)
Sets/changes the analytic time for an equations set.
Definition: equations_set_routines.f90:877
equations_routines::equations_timing_output
integer(intg), parameter, public equations_timing_output
Timing information output.
Definition: equations_routines.f90:69
equations_set_routines::equations_set_source_create_start
subroutine, public equations_set_source_create_start(EQUATIONS_SET, SOURCE_FIELD_USER_NUMBER, SOURCE_FIELD, ERR, ERROR,)
Start the creation of a source for an equations set.
Definition: equations_set_routines.f90:5848
equations_matrices_routines::equations_matrices_linear_only
integer(intg), parameter, public equations_matrices_linear_only
Select only the linear equations matrices and vectors.
Definition: equations_matrices_routines.f90:100
coordinate_routines::coordinate_jacobian_no_type
integer(intg), parameter, public coordinate_jacobian_no_type
No Jacobian.
Definition: coordinate_routines.f90:91
equations_set_routines::equationsset_derivedcreatefinish
subroutine, public equationsset_derivedcreatefinish(equationsSet, err, error,)
Finish the creation of a derived variables field for an equations set.
Definition: equations_set_routines.f90:4209
equations_set_routines::equationsset_assemblequasistaticlinearfem
subroutine equationsset_assemblequasistaticlinearfem(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations stiffness matrix and rhs for a linear quasistatic equations set using the fin...
Definition: equations_set_routines.f90:1676
input_output::write_string_matrix
Write a string followed by a matrix to a specified output stream.
Definition: input_output.f90:326
equations_set_routines::equations_set_solution_method_set
subroutine, public equations_set_solution_method_set(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for an equations set.
Definition: equations_set_routines.f90:5697
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_set_routines::equations_set_residual_evaluate
subroutine, public equations_set_residual_evaluate(EQUATIONS_SET, ERR, ERROR,)
Evaluates the residual for an equations set.
Definition: equations_set_routines.f90:5191
equations_set_constants::equations_set_fluid_mechanics_class
integer(intg), parameter equations_set_fluid_mechanics_class
Definition: equations_set_constants.f90:55
equations_set_routines::equationsset_tensorinterpolatexi
subroutine, public equationsset_tensorinterpolatexi(equationsSet, tensorEvaluateType, userElementNumber, xi, values, err, error,)
Evaluate a tensor at a given element xi location.
Definition: equations_set_routines.f90:6321
equations_set_routines::equationsset_equationssetfieldinitialise
subroutine equationsset_equationssetfieldinitialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the equations set field for a equations set.
Definition: equations_set_routines.f90:4487
types::nodalvectortype
Contains information for an nodal vector.
Definition: types.f90:1421
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
fluid_mechanics_routines::fluidmechanics_equationssetspecificationset
subroutine, public fluidmechanics_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for a fluid mechanics equation set class.
Definition: fluid_mechanics_routines.f90:183
equations_set_routines::equations_set_setup_initialise
subroutine equations_set_setup_initialise(EQUATIONS_SET_SETUP_INFO, ERR, ERROR,)
Initialise the equations set setup.
Definition: equations_set_routines.f90:5670
classical_field_routines::classicalfield_finiteelementjacobianevaluate
subroutine, public classicalfield_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element Jacobian matrix for the given element number for a clasical field class finite ...
Definition: classical_field_routines.f90:345
fluid_mechanics_routines::fluidmechanics_equationssetsolutionmethodset
subroutine, public fluidmechanics_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a fluid mechanics equation set class.
Definition: fluid_mechanics_routines.f90:572
equations_routines::equations_matrix_output
integer(intg), parameter, public equations_matrix_output
All below and equation matrices output.
Definition: equations_routines.f90:70
equations_set_routines::equationsset_specificationsizeget
subroutine, public equationsset_specificationsizeget(equationsSet, specificationSize, err, error,)
Gets the size of the equations set specification array for a problem identified by a pointer...
Definition: equations_set_routines.f90:6103
classical_field_routines
This module handles all classical field class routines.
Definition: classical_field_routines.f90:45
equations_matrices_routines::equations_matrices_jacobian_element_add
subroutine, public equations_matrices_jacobian_element_add(EQUATIONS_MATRICES, ERR, ERROR,)
Adds the Jacobain matrices into the equations Jacobian.
Definition: equations_matrices_routines.f90:3175
types::equations_set_equations_set_field_type
Definition: types.f90:1933
equations_set_routines::equationsset_specificationget
subroutine, public equationsset_specificationget(equationsSet, equationsSetSpecification, err, error,)
Returns the equations set specification i.e., equations set class, type and subtype for an equations ...
Definition: equations_set_routines.f90:6055
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
distributed_matrix_vector::distributedvector_l2norm
subroutine, public distributedvector_l2norm(distributedVector, norm, err, error,)
Calculates the L2 norm of a distributed vector values on this computational node. ...
Definition: distributed_matrix_vector.f90:8322
equations_matrices_routines::equationsmatrices_nodalinitialise
subroutine, public equationsmatrices_nodalinitialise(equationsMatrices, err, error,)
Initialise the nodal calculation information for the equations matrices.
Definition: equations_matrices_routines.f90:2150
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
equations_routines::equations_element_matrix_output
integer(intg), parameter, public equations_element_matrix_output
All below and element matrices output.
Definition: equations_routines.f90:71
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
equations_set_routines::equations_set_materials_finalise
subroutine equations_set_materials_finalise(EQUATIONS_SET_MATERIALS, ERR, ERROR,)
Finalise the materials for an equations set.
Definition: equations_set_routines.f90:3903
equations_set_routines::equations_set_source_create_finish
subroutine, public equations_set_source_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of a source for an equation set.
Definition: equations_set_routines.f90:5795
equations_set_routines::equations_set_analytic_create_finish
subroutine, public equations_set_analytic_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of a analytic solution for equations set.
Definition: equations_set_routines.f90:167
timer::user_cpu
integer(intg), parameter, public user_cpu
User CPU time type.
Definition: timer_f.f90:68
elasticity_routines::elasticity_finite_element_jacobian_evaluate
subroutine, public elasticity_finite_element_jacobian_evaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the Jacobian for the given element number for an elasticity class finite element equation s...
Definition: elasticity_routines.f90:197
equations_set_routines::equationsset_finiteelementresidualevaluate
subroutine equationsset_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element residual and rhs vector for the given element number for a finite element equat...
Definition: equations_set_routines.f90:3164
equations_set_constants::equations_set_number_of_derived_types
integer(intg), parameter equations_set_number_of_derived_types
Definition: equations_set_constants.f90:391
equations_set_routines::equationsset_derivedvariablecalculate
subroutine, public equationsset_derivedvariablecalculate(equationsSet, derivedType, err, error,)
Calculates a derived variable value for the equations set.
Definition: equations_set_routines.f90:6140
distributed_matrix_vector::distributed_matrix_column_major_storage_type
integer(intg), parameter, public distributed_matrix_column_major_storage_type
Distributed matrix column major storage type.
Definition: distributed_matrix_vector.f90:99
types::domain_elements_type
Contains the topology information for the elements of a domain.
Definition: types.f90:677
elasticity_routines::elasticity_boundaryconditionsanalyticcalculate
subroutine, public elasticity_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Sets the analytic boundary conditions for an elasticity equation set class.
Definition: elasticity_routines.f90:545
equations_set_routines::equations_set_dependent_create_start
subroutine, public equations_set_dependent_create_start(EQUATIONS_SET, DEPENDENT_FIELD_USER_NUMBER, DEPENDENT_FIELD, ERR, ERROR,)
Start the creation of dependent variables for an equations set.
Definition: equations_set_routines.f90:4017
equations_set_constants::equations_set_setup_derived_type
integer(intg), parameter equations_set_setup_derived_type
Derived field setup.
Definition: equations_set_constants.f90:331
equations_set_constants::equations_set_monodomain_strang_splitting_equation_type
integer(intg), parameter equations_set_monodomain_strang_splitting_equation_type
Definition: equations_set_constants.f90:99
equations_set_routines::equations_set_independent_create_start
subroutine, public equations_set_independent_create_start(EQUATIONS_SET, INDEPENDENT_FIELD_USER_NUMBER, INDEPENDENT_FIELD, ERR, ERROR,)
Start the creation of independent variables for an equations set.
Definition: equations_set_routines.f90:3402
equations_set_constants::equations_second_order_dynamic
integer(intg), parameter equations_second_order_dynamic
The equations are a second order dynamic.
Definition: equations_set_constants.f90:379
equations_set_constants::equations_first_order_dynamic
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Definition: equations_set_constants.f90:378
equations_set_routines::equations_set_analytic_user_param_get
subroutine, public equations_set_analytic_user_param_get(EQUATIONS_SET, PARAM_IDX, PARAM, ERR, ERROR,)
Sets the analytic problem user parameter.
Definition: equations_set_routines.f90:949
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
types::equations_set_ptr_type
A buffer type to allow for an array of pointers to a EQUATIONS_SET_TYPE.
Definition: types.f90:1962
types::equations_mapping_source_type
Contains information on the equations mapping for a source i.e., how a field variable is mapped to th...
Definition: types.f90:1647
equations_set_routines::equations_set_solution_method_get
subroutine, public equations_set_solution_method_get(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Returns the solution method for an equations set.
Definition: equations_set_routines.f90:5763
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
boundary_conditions_routines::boundary_condition_neumann_point
integer(intg), parameter, public boundary_condition_neumann_point
The dof is set to a Neumann point boundary condition.
Definition: boundary_condition_routines.f90:101
types::field_interpolated_point_metrics_ptr_type
Definition: types.f90:1124
classical_field_routines::classicalfield_boundaryconditionsanalyticcalculate
subroutine, public classicalfield_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Sets the analytic boundary conditions for a classical field equation set class.
Definition: classical_field_routines.f90:591
fluid_mechanics_routines::fluidmechanics_boundaryconditionsanalyticcalculate
subroutine, public fluidmechanics_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Sets the analytic boundary conditions for a fluid mechanics equation set class.
Definition: fluid_mechanics_routines.f90:628
elasticity_routines::elasticity_finite_element_residual_evaluate
subroutine, public elasticity_finite_element_residual_evaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the residual and rhs vector for the given element number for an elasticity class finite ele...
Definition: elasticity_routines.f90:241
equations_set_routines::equationsset_derivedvariableset
subroutine, public equationsset_derivedvariableset(equationsSet, derivedType, fieldVariableType, err, error,)
Sets the field variable type of the derived field to be used to store a derived variable.
Definition: equations_set_routines.f90:6197
bioelectric_routines::bioelectric_equationssetspecificationset
subroutine, public bioelectric_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for a bioelectric equation set class.
Definition: bioelectric_routines.f90:149
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
equations_matrices_routines::equations_matrices_jacobian_only
integer(intg), parameter, public equations_matrices_jacobian_only
Select only the Jacobian equations matrix.
Definition: equations_matrices_routines.f90:102
equations_set_constants::equations_set_elasticity_class
integer(intg), parameter equations_set_elasticity_class
Definition: equations_set_constants.f90:54
equations_set_routines::equations_set_independent_destroy
subroutine, public equations_set_independent_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the independent field for an equations set.
Definition: equations_set_routines.f90:3513
types::equations_mapping_nonlinear_type
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
bioelectric_routines::bioelectric_equationssetsolutionmethodset
subroutine, public bioelectric_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a bioelectric equation set class.
Definition: bioelectric_routines.f90:281
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
equations_matrices_routines::equations_jacobian_finite_difference_calculated
integer(intg), parameter, public equations_jacobian_finite_difference_calculated
Use finite differencing to calculate the Jacobian.
Definition: equations_matrices_routines.f90:115
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
types::boundary_conditions_dirichlet_type
Contains information on dofs with associated dirichlet conditions and corresponding non-zero elements...
Definition: types.f90:1794
equations_set_routines::equationsset_derivedinitialise
subroutine equationsset_derivedinitialise(equationsSet, err, error,)
Initialises the derived variables for a equations set.
Definition: equations_set_routines.f90:4422
fluid_mechanics_routines
This module handles all fluid mechanics class routines.
Definition: fluid_mechanics_routines.f90:50
classical_field_routines::classicalfield_finiteelementresidualevaluate
subroutine, public classicalfield_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element residual and rhs vectors for the given element number for a clasical field clas...
Definition: classical_field_routines.f90:407
classical_field_routines::classicalfield_equationssetspecificationset
subroutine, public classicalfield_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equations set specification for a classical field equation set.
Definition: classical_field_routines.f90:225
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_set_routines::equations_set_dependent_create_finish
subroutine, public equations_set_dependent_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of a dependent variables for an equations set.
Definition: equations_set_routines.f90:3968
distributed_matrix_vector::distributed_vector_copy
Definition: distributed_matrix_vector.f90:360
elasticity_routines::elasticity_equationssetsolutionmethodset
subroutine, public elasticity_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for an elasticity equation set class.
Definition: elasticity_routines.f90:418
equations_set_routines::equations_set_analytic_finalise
subroutine equations_set_analytic_finalise(EQUATIONS_SET_ANALYTIC, ERR, ERROR,)
Finalise the analytic solution for an equations set and deallocate all memory.
Definition: equations_set_routines.f90:705
equations_set_routines::equations_set_finalise
subroutine equations_set_finalise(EQUATIONS_SET, ERR, ERROR,)
Finalise the equations set and deallocate all memory.
Definition: equations_set_routines.f90:2699
equations_set_routines::equations_set_user_number_find
subroutine, public equations_set_user_number_find(USER_NUMBER, REGION, EQUATIONS_SET, ERR, ERROR,)
Finds and returns in EQUATIONS_SET a pointer to the equations set identified by USER_NUMBER in the gi...
Definition: equations_set_routines.f90:6381
types::field_physical_point_ptr_type
Buffer type to allow for arrays of pointers to FIELD_PHYSICAL_POINT_TYPE.
Definition: types.f90:1107
timer::system_cpu
integer(intg), parameter, public system_cpu
System CPU time type.
Definition: timer_f.f90:69
equations_matrices_routines::equations_jacobian_analytic_calculated
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
Definition: equations_matrices_routines.f90:116
equations_set_routines::equations_set_analytic_create_start
subroutine, public equations_set_analytic_create_start(EQUATIONS_SET, ANALYTIC_FUNCTION_TYPE, ANALYTIC_FIELD_USER_NUMBER, ANALYTIC_FIELD, ERR, ERROR,)
Start the creation of a analytic solution for a equations set.
Definition: equations_set_routines.f90:219
types::equations_set_source_type
Contains information on the source for the equations set.
Definition: types.f90:1915
equations_set_constants::equations_set_electromagnetics_class
integer(intg), parameter equations_set_electromagnetics_class
Definition: equations_set_constants.f90:56
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
fluid_mechanics_routines::fluidmechanics_finiteelementresidualevaluate
subroutine, public fluidmechanics_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element residual and rhs vectors for the given element number for a fluid mechanics cla...
Definition: fluid_mechanics_routines.f90:351
types::equations_set_materials_type
Definition: types.f90:1881
equations_set_routines::equationsset_derivedcreatestart
subroutine, public equationsset_derivedcreatestart(equationsSet, derivedFieldUserNumber, derivedField, err, error,)
Start the creation of derived variables field for an equations set.
Definition: equations_set_routines.f90:4262
equations_set_routines::equations_set_analytic_functions_evaluate
subroutine equations_set_analytic_functions_evaluate(EQUATIONS_SET, ANALYTIC_FUNCTION_TYPE, POSITION, TANGENTS, NORMAL, TIME, VARIABLE_TYPE, GLOBAL_DERIVATIVE, COMPONENT_NUMBER, ANALYTIC_PARAMETERS, MATERIALS_PARAMETERS, VALUE, ERR, ERROR,)
Evaluate the analytic solution for an equations set.
Definition: equations_set_routines.f90:731
cmiss_mpi
This module contains CMISS MPI routines.
Definition: cmiss_mpi.f90:45
input_output::write_string_matrix_name_and_indices
integer(intg), parameter, public write_string_matrix_name_and_indices
Write the matrix name together with the matrix indices.
Definition: input_output.f90:66
equations_set_routines::equationsset_finiteelementjacobianevaluate
subroutine equationsset_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element Jacobian for the given element number for a finite element equations set...
Definition: equations_set_routines.f90:2918
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
elasticity_routines::elasticity_equationssetspecificationset
subroutine, public elasticity_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for an elasticity equation set class.
Definition: elasticity_routines.f90:109
equations_set_routines::equations_set_setup
subroutine equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP_INFO, ERR, ERROR,)
Sets up the specifices for an equation set.
Definition: equations_set_routines.f90:4520
types::element_matrix_type
Contains information for an element matrix.
Definition: types.f90:1387
elasticity_routines::elasticity_finite_element_calculate
subroutine, public elasticity_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for an elasticit...
Definition: elasticity_routines.f90:153
fluid_mechanics_routines::fluidmechanics_nodaljacobianevaluate
subroutine, public fluidmechanics_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal Jacobian matrix for the given node number for a fluid mechanics class nodal equat...
Definition: fluid_mechanics_routines.f90:407
equations_set_routines::equations_set_dependent_destroy
subroutine, public equations_set_dependent_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the dependent variables for an equations set.
Definition: equations_set_routines.f90:4126
types::equations_set_analytic_type
Contains information on the analytic setup for the equations set.
Definition: types.f90:1923
equations_set_routines::equations_set_materials_destroy
subroutine, public equations_set_materials_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the materials for an equations set.
Definition: equations_set_routines.f90:3872
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
types::equations_set_geometry_type
Contains information on the geometry for an equations set.
Definition: types.f90:1875
fluid_mechanics_routines::fluidmechanics_finiteelementjacobianevaluate
subroutine, public fluidmechanics_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element Jacobian matrix for the given element number for a fluid mechanics class finite...
Definition: fluid_mechanics_routines.f90:295
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
equations_set_routines::equations_set_materials_create_start
subroutine, public equations_set_materials_create_start(EQUATIONS_SET, MATERIALS_FIELD_USER_NUMBER, MATERIALS_FIELD, ERR, ERROR,)
Start the creation of materials for a problem.
Definition: equations_set_routines.f90:3761
classical_field_routines::classical_field_analytic_functions_evaluate
subroutine, public classical_field_analytic_functions_evaluate(EQUATIONS_SET, EQUATIONS_TYPE, ANALYTIC_FUNCTION_TYPE, POSITION, TANGENTS, NORMAL, TIME, VARIABLE_TYPE, GLOBAL_DERIVATIVE, COMPONENT_NUMBER, ANALYTIC_PARAMETERS, MATERIALS_PARAMETERS, VALUE, ERR, ERROR,)
Evaluate the analytic solution for a classical field equations set.
Definition: classical_field_routines.f90:108
distributed_matrix_vector::distributed_matrix_storage_type_get
subroutine, public distributed_matrix_storage_type_get(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Gets the storage type of a distributed matrix.
Definition: distributed_matrix_vector.f90:3143
equations_set_constants::equations_set_classical_field_class
integer(intg), parameter equations_set_classical_field_class
Definition: equations_set_constants.f90:57
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
equations_set_routines::equations_set_finite_element_calculate
subroutine equations_set_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for a finite ele...
Definition: equations_set_routines.f90:2735
equations_set_routines::equationsset_assemblequasistaticnonlinearfem
subroutine equationsset_assemblequasistaticnonlinearfem(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations stiffness matrix, residuals and rhs for a nonlinear quasistatic equations set...
Definition: equations_set_routines.f90:1653
types::field_interpolated_point_ptr_type
Definition: types.f90:1136
types::distributed_vector_type
Contains the information for a vector that is distributed across a number of domains.
Definition: types.f90:786
fitting_routines::fitting_equationssetspecificationset
subroutine, public fitting_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for a data fitting equation set class.
Definition: fitting_routines.f90:2061
equations_set_routines::equations_set_source_destroy
subroutine, public equations_set_source_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the source for an equations set.
Definition: equations_set_routines.f90:5959
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_set_routines::equations_set_boundary_conditions_increment
subroutine equations_set_boundary_conditions_increment(EQUATIONS_SET, BOUNDARY_CONDITIONS, ITERATION_NUMBER, MAXIMUM_NUMBER_OF_ITERATIONS, ERR, ERROR,)
Apply the boundary condition load increment to dependent field.
Definition: equations_set_routines.f90:6500
distributed_matrix_vector::distributed_matrix_storage_locations_get
subroutine, public distributed_matrix_storage_locations_get(DISTRIBUTED_MATRIX, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Gets the storage locations (sparsity pattern) for a distributed matrix.
Definition: distributed_matrix_vector.f90:2870
equations_set_routines::equations_set_create_start
subroutine, public equations_set_create_start(USER_NUMBER, REGION, GEOM_FIBRE_FIELD, EQUATIONS_SET_SPECIFICATION, EQUATIONS_SET_FIELD_USER_NUMBER, EQUATIONS_SET_FIELD_FIELD, EQUATIONS_SET, ERR, ERROR,)
Starts the process of creating an equations set defined by USER_NUMBER in the region identified by RE...
Definition: equations_set_routines.f90:2362
equations_set_routines::equations_set_analytic_initialise
subroutine equations_set_analytic_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the analytic solution for an equations set.
Definition: equations_set_routines.f90:803
boundary_conditions_routines::boundary_condition_dof_mixed
integer(intg), parameter, public boundary_condition_dof_mixed
The dof is set as a mixed boundary condition.
Definition: boundary_condition_routines.f90:88
equations_routines::equations_nodal_matrix_output
integer(intg), parameter, public equations_nodal_matrix_output
All below and nodal matrices output.
Definition: equations_routines.f90:72
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
distributed_matrix_vector::distributed_matrix_data_restore
Definition: distributed_matrix_vector.f90:158
equations_set_constants::equations_set_modal_class
integer(intg), parameter equations_set_modal_class
Definition: equations_set_constants.f90:60
equations_set_routines::equations_set_jacobian_evaluate_dynamic_fem
subroutine equations_set_jacobian_evaluate_dynamic_fem(EQUATIONS_SET, ERR, ERROR,)
Evaluates the Jacobian for an dynamic equations set using the finite element method.
Definition: equations_set_routines.f90:5038
distributed_matrix_vector::distributed_matrix_compressed_column_storage_type
integer(intg), parameter, public distributed_matrix_compressed_column_storage_type
Distributed matrix compressed column storage type.
Definition: distributed_matrix_vector.f90:102
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
equations_set_routines::equations_set_backsubstitute
subroutine, public equations_set_backsubstitute(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Backsubstitutes with an equations set to calculate unknown right hand side vectors.
Definition: equations_set_routines.f90:1828
equations_set_routines::equations_set_geometry_initialise
subroutine equations_set_geometry_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the geometry for an equation set.
Definition: equations_set_routines.f90:3679
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
fluid_mechanics_routines::fluid_mechanics_equations_set_setup
subroutine, public fluid_mechanics_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the equations set for a fluid mechanics equations set class.
Definition: fluid_mechanics_routines.f90:515
equations_set_routines::equations_set_destroy
subroutine, public equations_set_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroys an equations set identified by a pointer and deallocates all memory.
Definition: equations_set_routines.f90:2635
timer::cpu_timer
subroutine, public cpu_timer(TIME_TYPE, TIME, ERR, ERROR,)
CPU_TIMER returns the CPU time in TIME(1). TIME_TYPE indicates the type of time required.
Definition: timer_f.f90:99
equations_set_routines::equationsset_nodalresidualevaluate
subroutine equationsset_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal residual and rhs vector for the given node number for a nodal equations set...
Definition: equations_set_routines.f90:7116
equations_set_routines::equations_set_equations_create_finish
subroutine, public equations_set_equations_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of equations for the equations set.
Definition: equations_set_routines.f90:4583
equations_set_routines::equationsset_assemblestaticnonlinearnodal
subroutine equationsset_assemblestaticnonlinearnodal(equationsSet, err, error,)
Assembles the equations stiffness matrix, residuals and rhs for a nonlinear static equations set usin...
Definition: equations_set_routines.f90:6844
equations_set_routines::equationsset_derivedfinalise
subroutine equationsset_derivedfinalise(equationsSetDerived, err, error,)
Finalises the derived variables for an equation set and deallocates all memory.
Definition: equations_set_routines.f90:4397
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
types::field_parameter_set_type
A type to hold the parameter sets for a field.
Definition: types.f90:1268
distributed_matrix_vector::distributed_vector_data_get
Definition: distributed_matrix_vector.f90:382
elasticity_routines::elasticity_load_increment_apply
subroutine, public elasticity_load_increment_apply(EQUATIONS_SET, ITERATION_NUMBER, MAXIMUM_NUMBER_OF_ITERATIONS, ERR, ERROR,)
Apply load increments for equations sets.
Definition: elasticity_routines.f90:893
classical_field_routines::classicalfield_equationssetsolutionmethodset
subroutine, public classicalfield_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a classical field equation set class.
Definition: classical_field_routines.f90:529
equations_set_routines::equations_set_initialise
subroutine equations_set_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises an equations set.
Definition: equations_set_routines.f90:3608
equations_set_routines::equations_set_independent_create_finish
subroutine, public equations_set_independent_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of independent variables for an equations set.
Definition: equations_set_routines.f90:3349
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
types::equations_set_dependent_type
Contains information on the dependent variables for the equations set.
Definition: types.f90:1889
types::nodalmatrixtype
Contains information for an nodal matrix.
Definition: types.f90:1408
equations_matrices_routines::equationsmatrices_nodalcalculate
subroutine, public equationsmatrices_nodalcalculate(equationsMatrices, nodeNumber, err, error,)
Calculate the positions in the equations matrices and rhs of the nodal matrices and rhs vector...
Definition: equations_matrices_routines.f90:1555
equations_set_routines::equations_set_assemble
subroutine, public equations_set_assemble(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations for an equations set.
Definition: equations_set_routines.f90:988
equations_matrices_routines::equations_matrices_jacobian_output
subroutine, public equations_matrices_jacobian_output(ID, EQUATIONS_MATRICES, ERR, ERROR,)
Outputs the equations Jacobian matrices.
Definition: equations_matrices_routines.f90:3232
equations_set_routines::equations_set_assemble_static_linear_fem
subroutine equations_set_assemble_static_linear_fem(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations stiffness matrix and rhs for a linear static equations set using the finite e...
Definition: equations_set_routines.f90:1302
equations_set_routines::equations_set_analytic_time_get
subroutine, public equations_set_analytic_time_get(EQUATIONS_SET, TIME, ERR, ERROR,)
Returns the analytic time for an equations set.
Definition: equations_set_routines.f90:844
equations_matrices_routines::equationsmatrices_nodeadd
subroutine, public equationsmatrices_nodeadd(equationsMatrices, err, error,)
Adds the nodal matrices and rhs vector into the equations matrices and rhs vector.
Definition: equations_matrices_routines.f90:2007
equations_set_routines::equationsset_nodaljacobianevaluate
subroutine equationsset_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal Jacobian for the given node number for a nodal equations set. ...
Definition: equations_set_routines.f90:6996
equations_matrices_routines::equations_matrices_element_initialise
subroutine, public equations_matrices_element_initialise(EQUATIONS_MATRICES, ERR, ERROR,)
Initialise the element calculation information for the equations matrices.
Definition: equations_matrices_routines.f90:2754
equations_set_routines::equationsset_finiteelementjacobianevaluatefd
subroutine equationsset_finiteelementjacobianevaluatefd(equationsSet, elementNumber, jacobianNumber, err, error,)
Evaluates the element Jacobian matrix entries using finite differencing for a general finite element ...
Definition: equations_set_routines.f90:3039
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_set_routines::equationsset_specificationset
subroutine equationsset_specificationset(equationsSet, specification, err, error,)
Sets/changes the equations set specification i.e., equations set class, type and subtype for an equat...
Definition: equations_set_routines.f90:6252
equations_set_constants::equations_nonlinear_bcs
integer(intg), parameter equations_nonlinear_bcs
The equations have non-linear boundary conditions.
Definition: equations_set_constants.f90:367
types::domain_mapping_type
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
equations_set_constants::equations_set_optimisation_class
integer(intg), parameter equations_set_optimisation_class
Definition: equations_set_constants.f90:62
equations_set_routines::equations_set_create_finish
subroutine, public equations_set_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finishes the process of creating an equation set on a region.
Definition: equations_set_routines.f90:2306
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
fitting_routines
This module handles all Galerkin projection routines.
Definition: fitting_routines.f90:45
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
fluid_mechanics_routines::fluidmechanics_nodalresidualevaluate
subroutine, public fluidmechanics_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal residual and rhs vectors for the given node number for a fluid mechanics class no...
Definition: fluid_mechanics_routines.f90:461
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
equations_matrices_routines::equations_matrices_element_finalise
subroutine, public equations_matrices_element_finalise(EQUATIONS_MATRICES, ERR, ERROR,)
Finalise the element calculation information and deallocate all memory.
Definition: equations_matrices_routines.f90:2658
equations_set_routines::equations_set_source_initialise
subroutine equations_set_source_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the source for an equations set.
Definition: equations_set_routines.f90:6015
types::equations_mapping_rhs_type
Contains information on the equations mapping for a RHS i.e., how a field variable is mapped to the R...
Definition: types.f90:1635
equations_matrices_routines::equations_matrices_output
subroutine, public equations_matrices_output(ID, EQUATIONS_MATRICES, ERR, ERROR,)
Outputs the equations matrices.
Definition: equations_matrices_routines.f90:3516
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_routines::equations_set_residual_evaluate_static_fem
subroutine equations_set_residual_evaluate_static_fem(EQUATIONS_SET, ERR, ERROR,)
Evaluates the residual for an static equations set using the finite element method.
Definition: equations_set_routines.f90:5490
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
bioelectric_routines
This module handles all bioelectric class routines.
Definition: bioelectric_routines.f90:45
boundary_conditions_routines::boundary_condition_fixed_incremented
integer(intg), parameter, public boundary_condition_fixed_incremented
The dof is a fixed boundary condition, to be used with load increment loop.
Definition: boundary_condition_routines.f90:106
lists
Implements lists of base types.
Definition: lists.f90:46
equations_set_routines::equationsset_deriveddestroy
subroutine, public equationsset_deriveddestroy(equationsSet, err, error,)
Destroy the derived variables for an equations set.
Definition: equations_set_routines.f90:4370
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
equations_set_routines::equations_set_assemble_static_nonlinear_fem
subroutine equations_set_assemble_static_nonlinear_fem(EQUATIONS_SET, ERR, ERROR,)
Assembles the equations stiffness matrix, residuals and rhs for a nonlinear static equations set usin...
Definition: equations_set_routines.f90:1500
types::distributed_matrix_type
Contains the information for a matrix that is distributed across a number of domains.
Definition: types.f90:828
equations_matrices_routines::equationsmatrices_jacobiannodeadd
subroutine, public equationsmatrices_jacobiannodeadd(equationsMatrices, err, error,)
Adds the Jacobian matrices into the equations Jacobian.
Definition: equations_matrices_routines.f90:2601
boundary_conditions_routines::boundary_conditions_variable_get
subroutine, public boundary_conditions_variable_get(BOUNDARY_CONDITIONS, FIELD_VARIABLE, BOUNDARY_CONDITIONS_VARIABLE, ERR, ERROR,)
Find the boundary conditions variable for a given field variable.
Definition: boundary_condition_routines.f90:3635
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
equations_set_routines::equations_set_equations_create_start
subroutine, public equations_set_equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_set_routines.f90:4628
equations_set_routines::equations_set_analytic_destroy
subroutine, public equations_set_analytic_destroy(EQUATIONS_SET, ERR, ERROR,)
Destroy the analytic solution for an equations set.
Definition: equations_set_routines.f90:332
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
equations_set_routines::equations_sets_finalise
subroutine, public equations_sets_finalise(REGION, ERR, ERROR,)
Finalises all equations sets on a region and deallocates all memory.
Definition: equations_set_routines.f90:6430
equations_set_routines::equations_set_setup_finalise
subroutine equations_set_setup_finalise(EQUATIONS_SET_SETUP_INFO, ERR, ERROR,)
Finalises the equations set setup and deallocates all memory.
Definition: equations_set_routines.f90:5643
bioelectric_routines::bioelectric_finite_element_calculate
subroutine, public bioelectric_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for a bioelectri...
Definition: bioelectric_routines.f90:193
base_routines::flag_error
Flags an error condition.
Definition: base_routines.f90:226
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
distributed_matrix_vector::distributed_matrix_row_column_storage_type
integer(intg), parameter, public distributed_matrix_row_column_storage_type
Distributed matrix row-column storage type.
Definition: distributed_matrix_vector.f90:103
equations_set_routines
This module handles all equations set routines.
Definition: equations_set_routines.f90:45
equations_set_routines::equations_set_materials_create_finish
subroutine, public equations_set_materials_create_finish(EQUATIONS_SET, ERR, ERROR,)
Finish the creation of materials for an equations set.
Definition: equations_set_routines.f90:3708
equations_set_routines::equations_set_equations_set_field_finalise
subroutine equations_set_equations_set_field_finalise(EQUATIONS_SET_FIELD, ERR, ERROR,)
Finalises the dependent variables for an equation set and deallocates all memory. ...
Definition: equations_set_routines.f90:4462
equations_set_constants::equations_quasistatic
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Definition: equations_set_constants.f90:377
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
types::element_vector_type
Contains information for an element vector.
Definition: types.f90:1400
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
equations_set_routines::equations_sets_initialise
subroutine, public equations_sets_initialise(REGION, ERR, ERROR,)
Intialises all equations sets on a region.
Definition: equations_set_routines.f90:6462
equations_set_routines::equations_set_nonlinear_rhs_update
subroutine, public equations_set_nonlinear_rhs_update(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Updates the right hand side variable from the equations residual vector.
Definition: equations_set_routines.f90:2104
fluid_mechanics_routines::fluid_mechanics_finite_element_calculate
subroutine, public fluid_mechanics_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for a fluid mech...
Definition: fluid_mechanics_routines.f90:239
monodomain_equations_routines
This module handles all Monodomain equations routines.
Definition: monodomain_equations_routines.f90:45
equations_matrices_routines::equations_matrices_values_initialise
subroutine, public equations_matrices_values_initialise(EQUATIONS_MATRICES, SELECTION_TYPE, VALUE, ERR, ERROR,)
Initialise the values of the equations matrices and vectors to the given value e.g., 0.0_DP.
Definition: equations_matrices_routines.f90:4437
equations_set_constants::equations_set_nodal_solution_method
integer(intg), parameter equations_set_nodal_solution_method
Similar to Finite Element Method with looping over nodes instead of elements.
Definition: equations_set_constants.f90:355
equations_set_constants::equations_set_multi_physics_class
integer(intg), parameter equations_set_multi_physics_class
Definition: equations_set_constants.f90:63
elasticity_routines::elasticity_equationssetderivedvariablecalculate
subroutine, public elasticity_equationssetderivedvariablecalculate(equationsSet, derivedType, err, error,)
Calculates a derived value for the elasticity equations set.
Definition: elasticity_routines.f90:463
boundary_conditions_routines::boundary_condition_dof_fixed
integer(intg), parameter, public boundary_condition_dof_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:87
bioelectric_routines::bioelectric_equations_set_setup
subroutine, public bioelectric_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the equations set for a bioelectric equations set class.
Definition: bioelectric_routines.f90:237
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
equations_set_routines::equations_set_analytic_user_param_set
subroutine, public equations_set_analytic_user_param_set(EQUATIONS_SET, PARAM_IDX, PARAM, ERR, ERROR,)
Sets the analytic problem user parameter.
Definition: equations_set_routines.f90:910
types::field_interpolation_parameters_ptr_type
Definition: types.f90:1151
equations_set_routines::equations_set_geometry_finalise
subroutine equations_set_geometry_finalise(EQUATIONS_SET_GEOMETRY, ERR, ERROR,)
Finalise the geometry for an equations set.
Definition: equations_set_routines.f90:3655
comp_environment::computational_node_number_get
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
Definition: computational_environment.f90:640
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
equations_set_constants::equations_time_stepping
integer(intg), parameter equations_time_stepping
The equations are for time stepping.
Definition: equations_set_constants.f90:380
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
distributed_matrix_vector::distributed_vector_values_get
Definition: distributed_matrix_vector.f90:476
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
types::equationssetderivedtype
Contains information on the derived variables for the equations set, eg. stress or strain...
Definition: types.f90:1897
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
equations_set_routines::equations_set_dependent_finalise
subroutine equations_set_dependent_finalise(EQUATIONS_SET_DEPENDENT, ERR, ERROR,)
Finalises the dependent variables for an equation set and deallocates all memory. ...
Definition: equations_set_routines.f90:4153
equations_set_routines::equations_set_independent_finalise
subroutine equations_set_independent_finalise(EQUATIONS_SET_INDEPENDENT, ERR, ERROR,)
Finalise the independent field for an equations set.
Definition: equations_set_routines.f90:3544
equations_set_routines::equations_set_jacobian_evaluate
subroutine, public equations_set_jacobian_evaluate(EQUATIONS_SET, ERR, ERROR,)
Evaluates the Jacobian for a nonlinear equations set.
Definition: equations_set_routines.f90:4701
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
classical_field_routines::classical_field_equations_set_setup
subroutine, public classical_field_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the equations set for a classical field equations set class.
Definition: classical_field_routines.f90:469
equations_set_constants::equations_set_fitting_class
integer(intg), parameter equations_set_fitting_class
Definition: equations_set_constants.f90:61
distributed_matrix_vector::distributed_vector_values_set
Definition: distributed_matrix_vector.f90:498
equations_set_routines::equations_set_load_increment_apply
subroutine, public equations_set_load_increment_apply(EQUATIONS_SET, BOUNDARY_CONDITIONS, ITERATION_NUMBER, MAXIMUM_NUMBER_OF_ITERATIONS, ERR, ERROR,)
Apply load increments for equations sets.
Definition: equations_set_routines.f90:6798
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45