OpenCMISS-Iron Internal API Documentation
equations_set_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE basis_routines
52  USE cmiss_mpi
54  USE constants
56  USE field_routines
59  USE domain_mappings
64  USE field_routines
66  USE input_output
68  USE kinds
69  USE lists
70  USE matrix_vector
72 #ifndef NOMPIMOD
73  USE mpi
74 #endif
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 
100 
102 
104 
106 
108 
110 
112 
114 
115  PUBLIC equations_set_destroy
116 
118 
120 
122 
124 
126 
128 
130 
132 
134 
136 
138 
140 
142 
144 
146 
148 
150 
152 
154 
156 
158 
159 CONTAINS
160 
161  !
162  !================================================================================================================================
163  !
164 
166  SUBROUTINE equations_set_analytic_create_finish(EQUATIONS_SET,ERR,ERROR,*)
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
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,*)
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
325 
326  !
327  !================================================================================================================================
328  !
329 
331  SUBROUTINE equations_set_analytic_destroy(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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,*)
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))
760  CALL flagerror("Not implemented.",err,error,*999)
762  CALL flagerror("Not implemented.",err,error,*999)
764  CALL flagerror("Not implemented.",err,error,*999)
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)
774  CALL flagerror("Not implemented.",err,error,*999)
776  CALL flagerror("Not implemented.",err,error,*999)
778  CALL flagerror("Not implemented.",err,error,*999)
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 
796 
797  !
798  !================================================================================================================================
799  !
800 
802  SUBROUTINE equations_set_analytic_initialise(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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
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
981 
982  !
983  !================================================================================================================================
984  !
985 
987  SUBROUTINE equations_set_assemble(EQUATIONS_SET,ERR,ERROR,*)
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)
1009  CALL equations_set_assemble_static_linear_fem(equations_set,err,error,*999)
1011  CALL flagerror("Not implemented.",err,error,*999)
1013  CALL flagerror("Not implemented.",err,error,*999)
1015  CALL flagerror("Not implemented.",err,error,*999)
1017  CALL flagerror("Not implemented.",err,error,*999)
1019  CALL flagerror("Not implemented.",err,error,*999)
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)
1031  CALL equations_set_assemble_static_nonlinear_fem(equations_set,err,error,*999)
1033  CALL equationsset_assemblestaticnonlinearnodal(equations_set,err,error,*999)
1035  CALL flagerror("Not implemented.",err,error,*999)
1037  CALL flagerror("Not implemented.",err,error,*999)
1039  CALL flagerror("Not implemented.",err,error,*999)
1041  CALL flagerror("Not implemented.",err,error,*999)
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
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)
1063  CALL equationsset_assemblequasistaticlinearfem(equations_set,err,error,*999)
1065  CALL flagerror("Not implemented.",err,error,*999)
1067  CALL flagerror("Not implemented.",err,error,*999)
1069  CALL flagerror("Not implemented.",err,error,*999)
1071  CALL flagerror("Not implemented.",err,error,*999)
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)
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
1090  SELECT CASE(equations%LINEARITY)
1091  CASE(equations_linear)
1092  SELECT CASE(equations_set%SOLUTION_METHOD)
1094  CALL equations_set_assemble_dynamic_linear_fem(equations_set,err,error,*999)
1096  CALL flagerror("Not implemented.",err,error,*999)
1098  CALL flagerror("Not implemented.",err,error,*999)
1100  CALL flagerror("Not implemented.",err,error,*999)
1102  CALL flagerror("Not implemented.",err,error,*999)
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)
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
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,*)
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
1295 
1296  !
1297  !================================================================================================================================
1298  !
1299 
1301  SUBROUTINE equations_set_assemble_static_linear_fem(EQUATIONS_SET,ERR,ERROR,*)
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
1493 
1494  !
1495  !================================================================================================================================
1496  !
1497 
1499  SUBROUTINE equations_set_assemble_static_nonlinear_fem(EQUATIONS_SET,ERR,ERROR,*)
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
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 
1669 
1670  !
1671  !================================================================================================================================
1672  !
1673 
1675  SUBROUTINE equationsset_assemblequasistaticlinearfem(EQUATIONS_SET,ERR,ERROR,*)
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
1821 
1822  !
1823  !================================================================================================================================
1824  !
1825 
1827  SUBROUTINE equations_set_backsubstitute(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
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)
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)
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
1950  !Do nothing
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
1969  CALL flagerror("Not implemented.",err,error,*999)
1971  CALL flagerror("Not implemented.",err,error,*999)
1973  CALL flagerror("Not implemented.",err,error,*999)
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)
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
1996  !Do nothing
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
2015  CALL flagerror("Not implemented.",err,error,*999)
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,*)
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)
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)
2177  !Do nothing
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,*)
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))
2263  CALL elasticity_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2265  CALL fluidmechanics_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2267  CALL flagerror("Not implemented.",err,error,*999)
2269  CALL classicalfield_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
2271  CALL flagerror("Not implemented.",err,error,*999)
2273  CALL flagerror("Not implemented.",err,error,*999)
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
2299 
2300  !
2301  !================================================================================================================================
2302  !
2303 
2305  SUBROUTINE equations_set_create_finish(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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,*)
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,*)
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,*)
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))
2767  CALL elasticity_finite_element_calculate(equations_set,element_number,err,error,*999)
2769  CALL fluid_mechanics_finite_element_calculate(equations_set,element_number,err,error,*999)
2771  CALL flagerror("Not implemented.",err,error,*999)
2773  CALL classical_field_finite_element_calculate(equations_set,element_number,err,error,*999)
2775  CALL fitting_finite_element_calculate(equations_set,element_number,err,error,*999)
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
2787  CALL flagerror("Not implemented.",err,error,*999)
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 
2911 
2912  !
2913  !================================================================================================================================
2914  !
2915 
2917  SUBROUTINE equationsset_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
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)
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))
2956  CALL elasticity_finite_element_jacobian_evaluate(equations_set,element_number,err,error,*999)
2958  CALL fluidmechanics_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2960  CALL flagerror("Not implemented.",err,error,*999)
2962  CALL classicalfield_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2964  CALL flagerror("Not implemented.",err,error,*999)
2966  CALL flagerror("Not implemented.",err,error,*999)
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
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 
3032 
3033  !
3034  !================================================================================================================================
3035  !
3036 
3038  SUBROUTINE equationsset_finiteelementjacobianevaluatefd(equationsSet,elementNumber,jacobianNumber,err,error,*)
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
3157 
3158  !
3159  !================================================================================================================================
3160  !
3161 
3163  SUBROUTINE equationsset_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
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))
3193  CALL elasticity_finite_element_residual_evaluate(equations_set,element_number,err,error,*999)
3195  CALL fluidmechanics_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3197  CALL flagerror("Not implemented.",err,error,*999)
3199  CALL classicalfield_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3201  CALL flagerror("Not implemented.",err,error,*999)
3203  CALL flagerror("Not implemented.",err,error,*999)
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 
3342 
3343  !
3344  !================================================================================================================================
3345  !
3346 
3348  SUBROUTINE equations_set_independent_create_finish(EQUATIONS_SET,ERR,ERROR,*)
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
3395 
3396  !
3397  !================================================================================================================================
3398  !
3399 
3401  SUBROUTINE equations_set_independent_create_start(EQUATIONS_SET,INDEPENDENT_FIELD_USER_NUMBER,INDEPENDENT_FIELD,ERR,ERROR,*)
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
3506 
3507  !
3508  !================================================================================================================================
3509  !
3510 
3512  SUBROUTINE equations_set_independent_destroy(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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
3601 
3602  !
3603  !================================================================================================================================
3604  !
3605 
3607  SUBROUTINE equations_set_initialise(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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,*)
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
3754 
3755  !
3756  !================================================================================================================================
3757  !
3758 
3760  SUBROUTINE equations_set_materials_create_start(EQUATIONS_SET,MATERIALS_FIELD_USER_NUMBER,MATERIALS_FIELD,ERR,ERROR,*)
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
3865 
3866  !
3867  !================================================================================================================================
3868  !
3869 
3871  SUBROUTINE equations_set_materials_destroy(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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,*)
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
4010 
4011  !
4012  !================================================================================================================================
4013  !
4014 
4016  SUBROUTINE equations_set_dependent_create_start(EQUATIONS_SET,DEPENDENT_FIELD_USER_NUMBER,DEPENDENT_FIELD,ERR,ERROR,*)
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
4119 
4120  !
4121  !================================================================================================================================
4122  !
4123 
4125  SUBROUTINE equations_set_dependent_destroy(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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,*)
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,*)
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,*)
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,*)
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,*)
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,*)
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,*)
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
4481 
4482  !
4483  !================================================================================================================================
4484  !
4486  SUBROUTINE equationsset_equationssetfieldinitialise(EQUATIONS_SET,ERR,ERROR,*)
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 
4511 
4512  !
4513  !================================================================================================================================
4514  !
4515 
4516 
4517 
4519  SUBROUTINE equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP_INFO,ERR,ERROR,*)
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))
4539  CALL elasticity_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4541  CALL fluid_mechanics_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4543  CALL flagerror("Not implemented.",err,error,*999)
4545  CALL classical_field_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
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
4557  CALL fitting_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4559  CALL flagerror("Not implemented.",err,error,*999)
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,*)
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
4611 
4612  !
4613  !================================================================================================================================
4614  !
4615 
4627  SUBROUTINE equations_set_equations_create_start(EQUATIONS_SET,EQUATIONS,ERR,ERROR,*)
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
4663 
4664  !
4665  !================================================================================================================================
4666  !
4667 
4669  SUBROUTINE equations_set_equations_destroy(EQUATIONS_SET,ERR,ERROR,*)
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,*)
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)
4722  CALL equations_set_assemble_static_linear_fem(equations_set,err,error,*999)
4724  CALL flagerror("Not implemented.",err,error,*999)
4726  CALL flagerror("Not implemented.",err,error,*999)
4728  CALL flagerror("Not implemented.",err,error,*999)
4730  CALL flagerror("Not implemented.",err,error,*999)
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)
4742  CALL equationsset_assemblequasistaticlinearfem(equations_set,err,error,*999)
4744  CALL flagerror("Not implemented.",err,error,*999)
4746  CALL flagerror("Not implemented.",err,error,*999)
4748  CALL flagerror("Not implemented.",err,error,*999)
4750  CALL flagerror("Not implemented.",err,error,*999)
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
4760  SELECT CASE(equations_set%SOLUTION_METHOD)
4762  CALL equations_set_assemble_dynamic_linear_fem(equations_set,err,error,*999)
4764  CALL flagerror("Not implemented.",err,error,*999)
4766  CALL flagerror("Not implemented.",err,error,*999)
4768  CALL flagerror("Not implemented.",err,error,*999)
4770  CALL flagerror("Not implemented.",err,error,*999)
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)
4789  CALL equations_set_jacobian_evaluate_static_fem(equations_set,err,error,*999)
4791  CALL equationsset_jacobianevaluatestaticnodal(equations_set,err,error,*999)
4793  CALL flagerror("Not implemented.",err,error,*999)
4795  CALL flagerror("Not implemented.",err,error,*999)
4797  CALL flagerror("Not implemented.",err,error,*999)
4799  CALL flagerror("Not implemented.",err,error,*999)
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)
4811  CALL equations_set_jacobian_evaluate_static_fem(equations_set,err,error,*999)
4813  CALL flagerror("Not implemented.",err,error,*999)
4815  CALL flagerror("Not implemented.",err,error,*999)
4817  CALL flagerror("Not implemented.",err,error,*999)
4819  CALL flagerror("Not implemented.",err,error,*999)
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
4829 ! sebk 15/09/09
4830  SELECT CASE(equations_set%SOLUTION_METHOD)
4832  CALL equations_set_jacobian_evaluate_dynamic_fem(equations_set,err,error,*999)
4834  CALL flagerror("Not implemented.",err,error,*999)
4836  CALL flagerror("Not implemented.",err,error,*999)
4838  CALL flagerror("Not implemented.",err,error,*999)
4840  CALL flagerror("Not implemented.",err,error,*999)
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
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
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,*)
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
5031 
5032  !
5033  !================================================================================================================================
5034  !
5035 
5037  SUBROUTINE equations_set_jacobian_evaluate_dynamic_fem(EQUATIONS_SET,ERR,ERROR,*)
5039  !Argument variables
5040  TYPE(