OpenCMISS-Iron Internal API Documentation
equations_mapping_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE domain_mappings
50  USE field_routines
51  USE input_output
53  USE kinds
54  USE strings
55  USE types
56 
57 #include "macros.h"
58 
59  IMPLICIT NONE
60 
61  PRIVATE
62 
63  !Module parameters
64 
65  !Module types
66 
67  !Module variables
68 
69  !Interfaces
70 
72  MODULE PROCEDURE equations_mapping_create_finish
73  END INTERFACE equationsmapping_createfinish
74 
76  MODULE PROCEDURE equations_mapping_create_start
77  END INTERFACE equationsmapping_createstart
78 
80  MODULE PROCEDURE equations_mapping_destroy
81  END INTERFACE equationsmapping_destroy
82 
87 
92 
97 
102 
106 
108  MODULE PROCEDURE equations_mapping_residual_coeff_set
110 
112  MODULE PROCEDURE equations_mapping_rhs_coeff_set
113  END INTERFACE equationsmapping_rhscoeffset
114 
118 
120  MODULE PROCEDURE equations_mapping_source_coeff_set
121  END INTERFACE equationsmapping_sourcecoeffset
122 
126 
128 
130 
132 
134 
137 
139 
142 
144 
146 
148 
150 
152 
154 
155 CONTAINS
156 
157  !
158  !================================================================================================================================
159  !
160 
162  SUBROUTINE equations_mapping_calculate(EQUATIONS_MAPPING,ERR,ERROR,*)
164  !Argument variables
165  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
166  INTEGER(INTG), INTENT(OUT) :: ERR
167  TYPE(varying_string), INTENT(OUT) :: ERROR
168  !Local Variables
169  INTEGER(INTG) :: column_idx,dof_idx,LINEAR_MATRIX_START,matrix_idx,NUMBER_OF_ROWS,NUMBER_OF_GLOBAL_ROWS,row_idx, &
170  & TOTAL_NUMBER_OF_ROWS,variable_idx,variable_type
171  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
172  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
173  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
174  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
175  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
176  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
177  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
178  TYPE(equations_type), POINTER :: EQUATIONS
179  TYPE(field_type), POINTER :: DEPENDENT_FIELD,SOURCE_FIELD
180  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,SOURCE_VARIABLE,ROW_VARIABLE
181  TYPE(varying_string) :: LOCAL_ERROR
182 
183  enters("EQUATIONS_MAPPING_CALCULATE",err,error,*999)
184 
185  IF(ASSOCIATED(equations_mapping)) THEN
186  equations=>equations_mapping%EQUATIONS
187  IF(ASSOCIATED(equations)) THEN
188  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
189  IF(ASSOCIATED(create_values_cache)) THEN
190  equations_set=>equations%EQUATIONS_SET
191  IF(ASSOCIATED(equations_set)) THEN
192  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
193  IF(ASSOCIATED(dependent_field)) THEN
194  IF(create_values_cache%SOURCE_VARIABLE_TYPE/=0) THEN
195  IF(ASSOCIATED(equations_set%SOURCE)) THEN
196  source_field=>equations_set%SOURCE%SOURCE_FIELD
197  IF(.NOT.ASSOCIATED(source_field)) THEN
198  CALL flagerror("Source field is not associated.",err,error,*999)
199  ENDIF
200  ELSE
201  CALL flagerror("Equations set source is not associated.",err,error,*999)
202  ENDIF
203  ENDIF
204  !Calculate the number of rows in the equations set
205  linear_matrix_start=1
206  SELECT CASE(equations%TIME_DEPENDENCE)
208  SELECT CASE(equations%LINEARITY)
210  !Static linear equations set
211  IF(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES>=1) THEN
212  linear_matrix_start=2
213  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1))%PTR
214  ELSE
215  CALL flagerror("The number of linear equations matrices must be at least one for a linear equations set.", &
216  & err,error,*999)
217  ENDIF
218  CASE(equations_nonlinear)
219  !Static nonlinear equations set
220  !Use first listed nonlinear variable
221  IF(create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES>=1) THEN
222  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RESIDUAL_VARIABLE_TYPES(1))%PTR
223  ELSE
224  CALL flagerror("The number of Jacobian matrices must be at least one for a nonlinear equations set.", &
225  & err,error,*999)
226  ENDIF
227  CASE DEFAULT
228  local_error="The equations linearity type of "// &
229  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
230  CALL flagerror(local_error,err,error,*999)
231  END SELECT
233  SELECT CASE(equations%LINEARITY)
235  !Dynamic linear equations set
236  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%DYNAMIC_VARIABLE_TYPE)%PTR
237  CASE(equations_nonlinear)
238  !Dynamic nonlinear equations set
239  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RESIDUAL_VARIABLE_TYPES(1))%PTR
240  CASE DEFAULT
241  local_error="The equations linearity type of "// &
242  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
243  CALL flagerror(local_error,err,error,*999)
244  END SELECT
246  !Time stepping DAE equations set
247 !!NOTE: The time stepping variable type doesn't have to come from the dependent field, it could come from, say, the source field.
248  !DEPENDENT_VARIABLE=>DEPENDENT_FIELD%VARIABLE_TYPE_MAP(CREATE_VALUES_CACHE%TIME_STEPPING_VARIABLE_TYPE)%PTR
249  CALL flagerror("Not implemented.",err,error,*999)
250  CASE DEFAULT
251  local_error="The equations time dependence type of "// &
252  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
253  CALL flagerror(local_error,err,error,*999)
254  END SELECT
255  IF(ASSOCIATED(dependent_variable)) THEN
256  number_of_rows=dependent_variable%NUMBER_OF_DOFS
257  total_number_of_rows=dependent_variable%TOTAL_NUMBER_OF_DOFS
258  equations_mapping%ROW_DOFS_MAPPING=>dependent_variable%DOMAIN_MAPPING
259  IF(ASSOCIATED(equations_mapping%ROW_DOFS_MAPPING)) THEN
260  number_of_global_rows=equations_mapping%ROW_DOFS_MAPPING%NUMBER_OF_GLOBAL
261  ELSE
262  CALL flagerror("Dependent variable domain mapping is not associated.",err,error,*999)
263  ENDIF
264  ELSE
265  CALL flagerror("The dependent variable mapped to the first matrix is not associated.",err,error,*999)
266  ENDIF
267  !Check that the number of rows is consistent across the remaining linear matrices
268  DO matrix_idx=linear_matrix_start,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
269  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache% &
270  & linear_matrix_variable_types(matrix_idx))%PTR
271  IF(ASSOCIATED(dependent_variable)) THEN
272  IF(dependent_variable%NUMBER_OF_DOFS/=number_of_rows) THEN
273  local_error="Invalid equations set up. The number of rows in the equations set ("// &
274  & trim(numbertovstring(number_of_rows,"*",err,error))// &
275  & ") does not match the number of rows in equations linear matrix number "// &
276  & trim(numbertovstring(matrix_idx,"*",err,error))//" ("// &
277  & trim(numbertovstring(dependent_variable%NUMBER_OF_DOFS,"*",err,error))//")."
278  CALL flagerror(local_error,err,error,*999)
279  ENDIF
280  IF(dependent_variable%TOTAL_NUMBER_OF_DOFS/=total_number_of_rows) THEN
281  local_error="Invalid equations set up. The total number of rows in the equations set ("// &
282  & trim(numbertovstring(total_number_of_rows,"*",err,error))// &
283  & ") does not match the total number of rows in equations matrix number "// &
284  & trim(numbertovstring(matrix_idx,"*",err,error))//" ("// &
285  & trim(numbertovstring(dependent_variable%TOTAL_NUMBER_OF_DOFS,"*",err,error))//")."
286  CALL flagerror(local_error,err,error,*999)
287  ENDIF
288  ELSE
289  local_error="The dependent variable mapped to linear matrix number "// &
290  & trim(numbertovstring(matrix_idx,"*",err,error))//" is not associated."
291  CALL flagerror(local_error,err,error,*999)
292  ENDIF
293  ENDDO !matrix_idx
294  !Check the Jacobian matrices
295  !Can't check the number of rows now as Jacobian's might not be square so just check variables are associated
296  DO matrix_idx=1,create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
297  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache% &
298  & residual_variable_types(matrix_idx))%PTR
299  IF(.NOT.ASSOCIATED(dependent_variable)) THEN
300  local_error="The dependent variable mapped to Jacobian matrix number "// &
301  & trim(numbertovstring(matrix_idx,"*",err,error))//" is not associated."
302  CALL flagerror(local_error,err,error,*999)
303  ENDIF
304  ENDDO !matrix_idx
305  !Check that the number of rows are consistent with the RHS vector if it exists
306  IF(create_values_cache%RHS_VARIABLE_TYPE/=0) THEN
307  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RHS_VARIABLE_TYPE)%PTR
308  IF(ASSOCIATED(dependent_variable)) THEN
309  IF(dependent_variable%NUMBER_OF_DOFS/=number_of_rows) THEN
310  local_error="Invalid equations set up. The number of rows in the equations set ("// &
311  & trim(numbertovstring(number_of_rows,"*",err,error))// &
312  & ") does not match the number of rows in the RHS vector ("// &
313  & trim(numbertovstring(dependent_variable%NUMBER_OF_DOFS,"*",err,error))//")."
314  CALL flagerror(local_error,err,error,*999)
315  ENDIF
316  IF(dependent_variable%TOTAL_NUMBER_OF_DOFS/=total_number_of_rows) THEN
317  local_error="Invalid equations set up. The total number of rows in the equations set ("// &
318  & trim(numbertovstring(total_number_of_rows,"*",err,error))// &
319  & ") does not match the total number of rows in the RHS vector ("// &
320  & trim(numbertovstring(dependent_variable%TOTAL_NUMBER_OF_DOFS,"*",err,error))//")."
321  CALL flagerror(local_error,err,error,*999)
322  ENDIF
323  ELSE
324  CALL flagerror("The dependent variable mapped to the RHS vector is not associated.",err,error,*999)
325  ENDIF
326  ENDIF
327  !!Check that the number of rows are consistent with the source vector if it exists
328  !IF(CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE/=0) THEN
329  ! SOURCE_VARIABLE=>SOURCE_FIELD%VARIABLE_TYPE_MAP(CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE)%PTR
330  ! IF(ASSOCIATED(SOURCE_VARIABLE)) THEN
331  ! IF(SOURCE_VARIABLE%NUMBER_OF_DOFS/=NUMBER_OF_ROWS) THEN
332  ! LOCAL_ERROR="Invalid equations set up. The number of rows in the equations set ("// &
333  ! & TRIM(NumberToVString(NUMBER_OF_ROWS,"*",ERR,ERROR))// &
334  ! & ") does not match the number of rows in the source vector ("// &
335  ! & TRIM(NumberToVString(SOURCE_VARIABLE%NUMBER_OF_DOFS,"*",ERR,ERROR))//")."
336  ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
337  ! ENDIF
338  ! IF(SOURCE_VARIABLE%TOTAL_NUMBER_OF_DOFS/=TOTAL_NUMBER_OF_ROWS) THEN
339  ! LOCAL_ERROR="Invalid equations set up. The total number of rows in the equations set ("// &
340  ! & TRIM(NumberToVString(TOTAL_NUMBER_OF_ROWS,"*",ERR,ERROR))// &
341  ! & ") does not match the total number of rows in the source vector ("// &
342  ! & TRIM(NumberToVString(SOURCE_VARIABLE%TOTAL_NUMBER_OF_DOFS,"*",ERR,ERROR))//")."
343  ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
344  ! ENDIF
345  ! ELSE
346  ! CALL FlagError("The source variable mapped to the source vector is not associated.",ERR,ERROR,*999)
347  ! ENDIF
348  !ENDIF
349  equations_mapping%NUMBER_OF_ROWS=number_of_rows
350  equations_mapping%TOTAL_NUMBER_OF_ROWS=total_number_of_rows
351  equations_mapping%NUMBER_OF_GLOBAL_ROWS=number_of_global_rows
352  !Calculate dynamic mappings
353  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE/=0) THEN
354  CALL equationsmapping_dynamicmappinginitialise(equations_mapping,err,error,*999)
355  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
356  IF(ASSOCIATED(dynamic_mapping)) THEN
357  dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
358  dynamic_mapping%STIFFNESS_MATRIX_NUMBER=create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER
359  dynamic_mapping%DAMPING_MATRIX_NUMBER=create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER
360  dynamic_mapping%MASS_MATRIX_NUMBER=create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER
361  !Initialise the variable type maps
362  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(field_number_of_variable_types),stat=err)
363  IF(err/=0) CALL flagerror("Could not allocate equations mapping variable to equations map.",err,error,*999)
364  DO variable_type=1,field_number_of_variable_types
366  & dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type),err,error,*999)
367  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE_INDEX=variable_type
368  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE_TYPE=variable_type
369  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE=>dependent_field% &
370  & variable_type_map(variable_type)%PTR
371  ENDDO !variable_type
372  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(create_values_cache%DYNAMIC_VARIABLE_TYPE)% &
373  & number_of_equations_matrices=create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
374  IF(create_values_cache%RHS_VARIABLE_TYPE/=0) dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
375  & create_values_cache%RHS_VARIABLE_TYPE)%NUMBER_OF_EQUATIONS_MATRICES=-1
376  !Allocate and initialise the variable to equations matrices maps
377  DO variable_type=1,field_number_of_variable_types
378  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
379  IF(ASSOCIATED(dependent_variable)) THEN
380  IF(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES==-1) THEN
381 !!TODO: check if this can be removed and just allocate those variables that are actually used
382  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP( &
383  & dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
384  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to rows map.", &
385  & err,error,*999)
386  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP=0
387  ELSE IF(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES>0) THEN
388  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
389  & dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES),stat=err)
390  IF(err/=0) &
391  & CALL flagerror("Could not allocate variable to equations matrices maps equations matrix numbers.", &
392  & err,error,*999)
393  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS( &
394  & dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES),stat=err)
395  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to columns map.", &
396  & err,error,*999)
397  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS=0
398  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==variable_type) THEN
399  IF(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER/=0) THEN
400  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
401  & create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER)=create_values_cache% &
402  & dynamic_stiffness_matrix_number
403  ENDIF
404  IF(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER/=0) THEN
405  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
406  & create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER)=create_values_cache% &
407  & dynamic_damping_matrix_number
408  ENDIF
409  IF(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER/=0) THEN
410  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
411  & create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER)=create_values_cache% &
412  & dynamic_mass_matrix_number
413  ENDIF
414  DO matrix_idx=1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES
415  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS( &
416  & matrix_idx)%COLUMN_DOF(dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
417  IF(err/=0) CALL flagerror("Could not allocate variable dof to columns map column dof.", &
418  & err,error,*999)
419  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
420  !1-1 mapping for now
421  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
422  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS(matrix_idx)% &
423  & column_dof(dof_idx)=column_idx
424  ENDDO !dof_idx
425  ENDDO !matrix_idx
426  ALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP( &
427  & dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
428  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to rows map.", &
429  & err,error,*999)
430  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
431  !1-1 mappings for now.
432  row_idx=dof_idx
433  dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP(dof_idx)=row_idx
434  ENDDO !dof_idx
435  ENDIF
436  ENDIF
437  ENDIF
438  ENDDO !variable_type
439  !Allocate and initialise the equations matrix to variable maps types
440  ALLOCATE(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES), &
441  & stat=err)
442  IF(err/=0) CALL flagerror("Could not allocate equations mapping equations matrix to variable maps.", &
443  & err,error,*999)
444  !Create the individual matrix maps and column maps
445  variable_type=create_values_cache%DYNAMIC_VARIABLE_TYPE
446  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
447  dynamic_mapping%DYNAMIC_VARIABLE_TYPE=variable_type
448  dynamic_mapping%DYNAMIC_VARIABLE=>dependent_variable
449  DO matrix_idx=1,dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
451  & equations_matrix_to_var_maps(matrix_idx),err,error,*999)
452  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%MATRIX_NUMBER=matrix_idx
453  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE_TYPE=variable_type
454  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE=>dependent_variable
455  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_COLUMNS=dependent_variable% &
456  & domain_mapping%NUMBER_OF_GLOBAL
457  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%MATRIX_COEFFICIENT=create_values_cache% &
458  & dynamic_matrix_coefficients(matrix_idx)
459  ALLOCATE(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP( &
460  & dependent_variable%DOMAIN_MAPPING%NUMBER_OF_GLOBAL),stat=err)
461  IF(err/=0) CALL flagerror("Could not allocate equation matrix to variable map column to dof map.",&
462  & err,error,*999)
463  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP=0
464  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
465  !1-1 mapping for now
466  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
467  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP(column_idx)=dof_idx
468  ENDDO !dof_idx
469  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING=> &
470  & dependent_variable%DOMAIN_MAPPING
471  ENDDO !matrix_idx
472  !Allocate the row mappings
473  ALLOCATE(dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS(equations_mapping%TOTAL_NUMBER_OF_ROWS),stat=err)
474  IF(err/=0) CALL flagerror("Could not allocate equations row to variable dof maps.",err,error,*999)
475  !Set up the row mappings
476  DO row_idx=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
477  !1-1 mapping for now
478  dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS(row_idx)=row_idx
479  ENDDO !row_idx
480  ELSE
481  CALL flagerror("Dynamic mapping is not associated.",err,error,*999)
482  ENDIF
483  ENDIF
484  !Calculate linear mappings
485  IF(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES>0) THEN
486  CALL equations_mapping_linear_mapping_initialise(equations_mapping,err,error,*999)
487  linear_mapping=>equations_mapping%LINEAR_MAPPING
488  IF(ASSOCIATED(linear_mapping)) THEN
489  linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
490  !Allocate and initialise the variable type maps
491  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(field_number_of_variable_types),stat=err)
492  IF(err/=0) CALL flagerror("Could not allocate equations mapping variable to equations map.",err,error,*999)
493  DO variable_type=1,field_number_of_variable_types
495  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type),err,error,*999)
496  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE_INDEX=variable_type
497  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE_TYPE=variable_type
498  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE=>dependent_field% &
499  & variable_type_map(variable_type)%PTR
500  ENDDO !variable_type
501  !Calculate the number of variable type maps and initialise
502  DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
503  variable_type=create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)
504  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES= &
505  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES+1
506  ENDDO !matrix_idx
507  IF(create_values_cache%RHS_VARIABLE_TYPE/=0) linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
508  & create_values_cache%RHS_VARIABLE_TYPE)%NUMBER_OF_EQUATIONS_MATRICES=-1
509  linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES=0
510  !Allocate and initialise the variable to equations matrices maps
511  DO variable_type=1,field_number_of_variable_types
512  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
513  IF(ASSOCIATED(dependent_variable)) THEN
514  IF(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
515  & number_of_equations_matrices==-1) THEN
516 !!TODO: check if this can be removed and just allocate those variables that are actually used
517  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP( &
518  & dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
519  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to rows map.", &
520  & err,error,*999)
521  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP=0
522  linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES=linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES+1
523  ELSE IF(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES>0) THEN
524  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
525  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES),stat=err)
526  IF(err/=0) &
527  & CALL flagerror("Could not allocate variable to equations matrices maps equations matrix numbers.", &
528  & err,error,*999)
529  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS( &
530  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES),stat=err)
531  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to columns map.", &
532  & err,error,*999)
533  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS=0
534  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES=0
535  DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
536  IF(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==variable_type) THEN
537  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES= &
538  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES+1
539  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%EQUATIONS_MATRIX_NUMBERS( &
540  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES)= &
541  & matrix_idx
542  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS( &
543  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
544  & number_of_equations_matrices)%COLUMN_DOF(dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
545  IF(err/=0) CALL flagerror("Could not allocate variable dof to columns map column dof.", &
546  & err,error,*999)
547  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
548  !1-1 mapping for now
549  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
550  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_COLUMNS_MAPS( &
551  & linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
552  & number_of_equations_matrices)%COLUMN_DOF(dof_idx)=column_idx
553  ENDDO !dof_idx
554  ENDIF
555  ENDDO !matrix_idx
556  ALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP( &
557  & dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
558  IF(err/=0) CALL flagerror("Could not allocate variable to equations matrices maps dof to rows map.", &
559  & err,error,*999)
560  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
561  !1-1 mappings for now.
562  row_idx=dof_idx
563  linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%DOF_TO_ROWS_MAP(dof_idx)=row_idx
564  ENDDO !dof_idx
565  linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES=linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES+1
566  ENDIF
567  ENDIF
568  ENDDO !variable_type
569  !Allocate and initialise the variable types
570  ALLOCATE(linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES(linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES),stat=err)
571  IF(err/=0) CALL flagerror("Could not allocate equations mapping matrix variable types.",err,error,*999)
572  linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES=0
573  DO variable_type=1,field_number_of_variable_types
574  IF(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES>0) THEN
575  linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES=linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES+1
576  linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES(linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES)=variable_type
577  ENDIF
578  ENDDO !variable_type
579  !Allocate and initialise the equations matrix to variable maps types
580  ALLOCATE(linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES), &
581  & stat=err)
582  IF(err/=0) CALL flagerror("Could not allocate equations mapping equations matrix to variable maps.", &
583  & err,error,*999)
584  !Create the individual matrix maps and column maps
585  DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
586  variable_type=create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)
587  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
589  & equations_matrix_to_var_maps(matrix_idx),err,error,*999)
590  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%MATRIX_NUMBER=matrix_idx
591  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE_TYPE=variable_type
592  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE=>dependent_variable
593  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_COLUMNS=dependent_variable% &
594  & domain_mapping%NUMBER_OF_GLOBAL
595  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%MATRIX_COEFFICIENT=equations_mapping% &
596  create_values_cache%LINEAR_MATRIX_COEFFICIENTS(matrix_idx)
597  ALLOCATE(linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP( &
598  & dependent_variable%DOMAIN_MAPPING%NUMBER_OF_GLOBAL),stat=err)
599  IF(err/=0) CALL flagerror("Could not allocate equation matrix to variable map column to dof map.",&
600  & err,error,*999)
601  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP=0
602  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
603  !1-1 mapping for now
604  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
605  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP(column_idx)=dof_idx
606  ENDDO !dof_idx
607  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING=> &
608  & dependent_variable%DOMAIN_MAPPING
609  ENDDO !matrix_idx
610  !Allocate the row mappings
611  ALLOCATE(linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS(equations_mapping%TOTAL_NUMBER_OF_ROWS, &
612  & linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES),stat=err)
613  IF(err/=0) CALL flagerror("Could not allocate equations row to variable dof maps.",err,error,*999)
614  !Set up the row mappings
615  DO variable_idx=1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES
616  DO row_idx=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
617  !1-1 mapping for now
618  linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS(row_idx,variable_idx)=row_idx
619  ENDDO !row_idx
620  ENDDO !variable_idx
621  ELSE
622  CALL flagerror("Linear mapping is not associated.",err,error,*999)
623  ENDIF
624  ENDIF
625  !Calculate non-linear mappings
626  IF(create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES/=0) THEN
627  CALL equationsmapping_nonlinearmappinginitialise(equations_mapping,err,error,*999)
628  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
629  IF(ASSOCIATED(nonlinear_mapping)) THEN
630  nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES=create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
631  ALLOCATE(nonlinear_mapping%VAR_TO_JACOBIAN_MAP(nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
632  IF(err/=0) CALL flagerror("Could not allocate variable to Jacobian maps.",err,error,*999)
633  ALLOCATE(nonlinear_mapping%JACOBIAN_TO_VAR_MAP(nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
634  IF(err/=0) CALL flagerror("Could not allocate Jacobian to variable maps.",err,error,*999)
635  ALLOCATE(nonlinear_mapping%RESIDUAL_VARIABLES(nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
636  IF(err/=0) CALL flagerror("Could not allocate nonlinear mapping residual variables.",err,error,*999)
637  DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
638  CALL equationsmapping_vartoequatsjacobianmapinitialise(nonlinear_mapping% &
639  & var_to_jacobian_map(matrix_idx),err,error,*999)
640  nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%JACOBIAN_NUMBER=matrix_idx
641  nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%VARIABLE_TYPE= &
642  & create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)
643  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache% &
644  & residual_variable_types(matrix_idx))%PTR
645  nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%VARIABLE=>dependent_variable
646  nonlinear_mapping%RESIDUAL_VARIABLES(matrix_idx)%PTR=>dependent_variable
647  !Row variable is RHS if set, otherwise first nonlinear variable
648  IF(create_values_cache%RHS_VARIABLE_TYPE/=0) THEN
649  row_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RHS_VARIABLE_TYPE)%PTR
650  ELSE
651  row_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RESIDUAL_VARIABLE_TYPES(1))%PTR
652  ENDIF
653  !Allocate and set dof to Jacobian columns map
654  ALLOCATE(nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_COLUMNS_MAP(dependent_variable% &
655  & total_number_of_dofs),stat=err)
656  IF(err/=0) CALL flagerror("Could not allocate variable to Jacobian map dof to columns map.",err,error,*999)
657  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
658  !1-1 mapping for now
659  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
660  nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_COLUMNS_MAP(dof_idx)=column_idx
661  ENDDO !dof_idx
662  !Allocate and set dof to Jacobian rows map
663  ALLOCATE(nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_ROWS_MAP(row_variable% &
664  & total_number_of_dofs),stat=err)
665  IF(err/=0) CALL flagerror("Could not allocate variable to Jacobian map dof to columns map.",err,error,*999)
666  DO dof_idx=1,row_variable%TOTAL_NUMBER_OF_DOFS
667  !1-1 mapping for now
668  row_idx=dof_idx
669  nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_ROWS_MAP(dof_idx)=row_idx
670  ENDDO !dof_idx
671  CALL equationsmapping_equatsjacobiantovarmapinitialise(nonlinear_mapping% &
672  & jacobian_to_var_map(matrix_idx),err,error,*999)
673  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%JACOBIAN_NUMBER=matrix_idx
674  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE_TYPE=create_values_cache% &
675  & residual_variable_types(matrix_idx)
676  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE=>dependent_variable
677  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%NUMBER_OF_COLUMNS= &
678  & dependent_variable%DOMAIN_MAPPING%NUMBER_OF_GLOBAL
679  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%JACOBIAN_COEFFICIENT=create_values_cache%RESIDUAL_COEFFICIENT
680  ALLOCATE(nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP( &
681  & dependent_variable%DOMAIN_MAPPING%NUMBER_OF_GLOBAL),stat=err)
682  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP=0
683  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
684  !1-1 mapping for now
685  column_idx=dependent_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
686  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP(column_idx)=dof_idx
687  ENDDO !dof_idx
688  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%COLUMN_DOFS_MAPPING=>dependent_variable%DOMAIN_MAPPING
689  ENDDO !matrix_idx
690  !Set up the row mappings
691  ALLOCATE(nonlinear_mapping%EQUATIONS_ROW_TO_RESIDUAL_DOF_MAP(total_number_of_rows),stat=err)
692  IF(err/=0) CALL flagerror("Could not allocate equations row to residual dof map.",err,error,*999)
693  DO row_idx=1,total_number_of_rows
694  !1-1 mapping for now
695  dof_idx=row_idx
696  nonlinear_mapping%EQUATIONS_ROW_TO_RESIDUAL_DOF_MAP(row_idx)=dof_idx
697  ENDDO !row_idx
698  ELSE
699  CALL flagerror("Nonlinear mapping is not associated.",err,error,*999)
700  ENDIF
701  ENDIF
702  !Calculate RHS mappings
703  IF(create_values_cache%RHS_VARIABLE_TYPE/=0) THEN
704  CALL equations_mapping_rhs_mapping_initialise(equations_mapping,err,error,*999)
705  rhs_mapping=>equations_mapping%RHS_MAPPING
706  IF(ASSOCIATED(rhs_mapping)) THEN
707  rhs_mapping%RHS_VARIABLE_TYPE=create_values_cache%RHS_VARIABLE_TYPE
708  dependent_variable=>dependent_field%VARIABLE_TYPE_MAP(create_values_cache%RHS_VARIABLE_TYPE)%PTR
709  rhs_mapping%RHS_VARIABLE=>dependent_variable
710  rhs_mapping%RHS_VARIABLE_MAPPING=>dependent_variable%DOMAIN_MAPPING
711  rhs_mapping%RHS_COEFFICIENT=create_values_cache%RHS_COEFFICIENT
712  !Allocate and set up the row mappings
713  ALLOCATE(rhs_mapping%RHS_DOF_TO_EQUATIONS_ROW_MAP(dependent_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
714  IF(err/=0) CALL flagerror("Could not allocate rhs dof to equations row map.",err,error,*999)
715  ALLOCATE(rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(total_number_of_rows),stat=err)
716  IF(err/=0) CALL flagerror("Could not allocate equations row to dof map.",err,error,*999)
717  DO dof_idx=1,dependent_variable%TOTAL_NUMBER_OF_DOFS
718  !1-1 mapping for now
719  row_idx=dof_idx
720  rhs_mapping%RHS_DOF_TO_EQUATIONS_ROW_MAP(dof_idx)=row_idx
721  ENDDO !dof_idx
722  DO row_idx=1,total_number_of_rows
723  !1-1 mapping for now
724  dof_idx=row_idx
725  rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(row_idx)=dof_idx
726  ENDDO !row_idx
727  ELSE
728  CALL flagerror("RHS mapping is not associated.",err,error,*999)
729  ENDIF
730  ENDIF
731  !Calcuate the source mappings
732  IF(create_values_cache%SOURCE_VARIABLE_TYPE/=0) THEN
733  CALL equations_mapping_source_mapping_initialise(equations_mapping,err,error,*999)
734  source_mapping=>equations_mapping%SOURCE_MAPPING
735  IF(ASSOCIATED(source_mapping)) THEN
736  source_mapping%SOURCE_VARIABLE_TYPE=create_values_cache%SOURCE_VARIABLE_TYPE
737  source_variable=>source_field%VARIABLE_TYPE_MAP(create_values_cache%SOURCE_VARIABLE_TYPE)%PTR
738  source_mapping%SOURCE_VARIABLE=>source_variable
739  ! SOURCE_MAPPING%SOURCE_VARIABLE_MAPPING=>SOURCE_VARIABLE%DOMAIN_MAPPING
740  ! SOURCE_MAPPING%SOURCE_COEFFICIENT=CREATE_VALUES_CACHE%SOURCE_COEFFICIENT
741  ! !Allocate and set up the row mappings
742  ! ALLOCATE(SOURCE_MAPPING%SOURCE_DOF_TO_EQUATIONS_ROW_MAP(SOURCE_VARIABLE%TOTAL_NUMBER_OF_DOFS),STAT=ERR)
743  ! IF(ERR/=0) CALL FlagError("Could not allocate source dof to equations row map.",ERR,ERROR,*999)
744  ! ALLOCATE(SOURCE_MAPPING%EQUATIONS_ROW_TO_SOURCE_DOF_MAP(TOTAL_NUMBER_OF_ROWS),STAT=ERR)
745  ! IF(ERR/=0) CALL FlagError("Could not allocate equations row to source map.",ERR,ERROR,*999)
746  ! DO dof_idx=1,SOURCE_VARIABLE%TOTAL_NUMBER_OF_DOFS
747  ! !1-1 mapping for now
748  ! row_idx=dof_idx
749  ! SOURCE_MAPPING%SOURCE_DOF_TO_EQUATIONS_ROW_MAP(dof_idx)=row_idx
750  ! ENDDO !dof_idx
751  ! DO row_idx=1,TOTAL_NUMBER_OF_ROWS
752  ! !1-1 mapping for now
753  ! dof_idx=row_idx
754  ! SOURCE_MAPPING%EQUATIONS_ROW_TO_SOURCE_DOF_MAP(row_idx)=dof_idx
755  ! ENDDO !row_idx
756  ELSE
757  CALL flagerror("Source mapping is not associated.",err,error,*999)
758  ENDIF
759  ENDIF
760  ELSE
761  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
762  ENDIF
763  ELSE
764  CALL flagerror("Equations equations set is not associated.",err,error,*999)
765  ENDIF
766  ELSE
767  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
768  ENDIF
769  ELSE
770  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
771  ENDIF
772  ELSE
773  CALL flagerror("Equations mapping is not associated.",err,error,*999)
774  ENDIF
775 
776  IF(diagnostics1) THEN
777  CALL write_string(diagnostic_output_type,"Equations mappings:",err,error,*999)
778  CALL write_string_value(diagnostic_output_type," Number of rows = ",equations_mapping%NUMBER_OF_ROWS,err,error,*999)
779  CALL write_string_value(diagnostic_output_type," Total umber of rows = ",equations_mapping%TOTAL_NUMBER_OF_ROWS, &
780  & err,error,*999)
781  CALL write_string_value(diagnostic_output_type," Number of global rows = ",equations_mapping%NUMBER_OF_GLOBAL_ROWS, &
782  & err,error,*999)
783  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
784  IF(ASSOCIATED(dynamic_mapping)) THEN
785  CALL write_string(diagnostic_output_type," Dynamic mappings:",err,error,*999)
786  CALL write_string_value(diagnostic_output_type," Number of dynamic equations matrices = ",dynamic_mapping% &
787  & number_of_dynamic_equations_matrices,err,error,*999)
788  CALL write_string_value(diagnostic_output_type," Dynamic stiffness matrix number = ",dynamic_mapping% &
789  & stiffness_matrix_number,err,error,*999)
790  CALL write_string_value(diagnostic_output_type," Dynamic damping matrix number = ",dynamic_mapping% &
791  & damping_matrix_number,err,error,*999)
792  CALL write_string_value(diagnostic_output_type," Dynamic mass matrix number = ",dynamic_mapping% &
793  & mass_matrix_number,err,error,*999)
794  CALL write_string_value(diagnostic_output_type," Dynamic variable type = ",dynamic_mapping% &
795  & dynamic_variable_type,err,error,*999)
796  CALL write_string(diagnostic_output_type," Variable to matrices mappings:",err,error,*999)
797  DO variable_type=1,field_number_of_variable_types
798  CALL write_string_value(diagnostic_output_type," Variable type : ",variable_type,err,error,*999)
799  IF(ASSOCIATED(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE)) THEN
800  CALL write_string_value(diagnostic_output_type," Total number of DOFs = ",dynamic_mapping% &
801  & var_to_equations_matrices_maps(variable_type)%VARIABLE%TOTAL_NUMBER_OF_DOFS,err,error,*999)
802  CALL write_string_value(diagnostic_output_type," Number of equations matrices = ",dynamic_mapping% &
803  & var_to_equations_matrices_maps(variable_type)%NUMBER_OF_EQUATIONS_MATRICES,err,error,*999)
804  IF(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES>0) THEN
805  CALL write_string_vector(diagnostic_output_type,1,1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
806  & number_of_equations_matrices,4,4,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
807  & equations_matrix_numbers,'(" Matrix numbers :",4(X,I12))','(22X,4(X,I12))',err,error,*999)
808  CALL write_string(diagnostic_output_type," DOF to column maps :",err,error,*999)
809  DO matrix_idx=1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES
810  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
811  CALL write_string_vector(diagnostic_output_type,1,1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
812  & variable_type)%VARIABLE%TOTAL_NUMBER_OF_DOFS,5,5,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
813  & variable_type)%DOF_TO_COLUMNS_MAPS(matrix_idx)%COLUMN_DOF, &
814  & '(" Column numbers :",5(X,I13))','(24X,5(X,I13))',err,error,*999)
815  ENDDO !matrix_idx
816  CALL write_string_vector(diagnostic_output_type,1,1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
817  & variable%TOTAL_NUMBER_OF_DOFS,5,5,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
818  & dof_to_rows_map,'(" DOF to row maps :",5(X,I13))','(24X,5(X,I13))',err,error,*999)
819  ENDIF
820  ENDIF
821  ENDDO !variable_type
822  CALL write_string(diagnostic_output_type," Matrix to variable mappings:",err,error,*999)
823  DO matrix_idx=1,dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
824  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
825  CALL write_string_value(diagnostic_output_type," Variable type = ",dynamic_mapping% &
826  & equations_matrix_to_var_maps(matrix_idx)%VARIABLE_TYPE,err,error,*999)
827  CALL write_string_value(diagnostic_output_type," Number of columns = ",dynamic_mapping% &
828  & equations_matrix_to_var_maps(matrix_idx)%NUMBER_OF_COLUMNS,err,error,*999)
829  CALL write_string_value(diagnostic_output_type," Matrix coefficient = ",dynamic_mapping% &
830  & equations_matrix_to_var_maps(matrix_idx)%MATRIX_COEFFICIENT,err,error,*999)
831  CALL write_string_vector(diagnostic_output_type,1,1,dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)% &
832  & number_of_columns,5,5,dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP, &
833  & '(" Column to DOF maps :",5(X,I13))','(28X,5(X,I13))',err,error,*999)
834  ENDDO !matrix_idx
835  CALL write_string(diagnostic_output_type," Row mappings:",err,error,*999)
836  CALL write_string_vector(diagnostic_output_type,1,1,equations_mapping%TOTAL_NUMBER_OF_ROWS,5,5, &
837  & dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS,'(" Row to DOF maps :",5(X,I13))','(21X,5(X,I13))', &
838  & err,error,*999)
839  ENDIF
840  linear_mapping=>equations_mapping%LINEAR_MAPPING
841  IF(ASSOCIATED(linear_mapping)) THEN
842  CALL write_string(diagnostic_output_type," Linear mappings:",err,error,*999)
843  CALL write_string_value(diagnostic_output_type," Number of linear equations matrices = ",linear_mapping% &
844  & number_of_linear_equations_matrices,err,error,*999)
845  CALL write_string_value(diagnostic_output_type," Number of linear matrix variables = ",linear_mapping% &
846  & number_of_linear_matrix_variables,err,error,*999)
847  CALL write_string_vector(diagnostic_output_type,1,1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES,4,4, &
848  & linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES,'(" Linear matrix variable types :",4(X,I12))','(27X,4(X,I12))', &
849  & err,error,*999)
850  CALL write_string(diagnostic_output_type," Variable to matrices mappings:",err,error,*999)
851  DO variable_type=1,field_number_of_variable_types
852  CALL write_string_value(diagnostic_output_type," Variable type : ",variable_type,err,error,*999)
853  IF(ASSOCIATED(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%VARIABLE)) THEN
854  CALL write_string_value(diagnostic_output_type," Total number of DOFs = ",linear_mapping% &
855  & var_to_equations_matrices_maps(variable_type)%VARIABLE%TOTAL_NUMBER_OF_DOFS,err,error,*999)
856  CALL write_string_value(diagnostic_output_type," Number of equations matrices = ",linear_mapping% &
857  & var_to_equations_matrices_maps(variable_type)%NUMBER_OF_EQUATIONS_MATRICES,err,error,*999)
858  IF(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES>0) THEN
859  CALL write_string_vector(diagnostic_output_type,1,1,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
860  & number_of_equations_matrices,4,4,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
861  & equations_matrix_numbers,'(" Matrix numbers :",4(X,I12))','(22X,4(X,I12))',err,error,*999)
862  CALL write_string(diagnostic_output_type," DOF to column maps :",err,error,*999)
863  DO matrix_idx=1,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)%NUMBER_OF_EQUATIONS_MATRICES
864  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
865  CALL write_string_vector(diagnostic_output_type,1,1,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
866  & variable_type)%VARIABLE%TOTAL_NUMBER_OF_DOFS,5,5,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
867  & variable_type)%DOF_TO_COLUMNS_MAPS(matrix_idx)%COLUMN_DOF, &
868  & '(" Column numbers :",5(X,I13))','(24X,5(X,I13))',err,error,*999)
869  ENDDO !matrix_idx
870  CALL write_string_vector(diagnostic_output_type,1,1,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
871  & variable%TOTAL_NUMBER_OF_DOFS,5,5,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS(variable_type)% &
872  & dof_to_rows_map,'(" DOF to row maps :",5(X,I13))','(24X,5(X,I13))',err,error,*999)
873  ENDIF
874  ENDIF
875  ENDDO !variable_type
876  CALL write_string(diagnostic_output_type," Matrix to variable mappings:",err,error,*999)
877  DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
878  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
879  CALL write_string_value(diagnostic_output_type," Variable type = ",linear_mapping% &
880  & equations_matrix_to_var_maps(matrix_idx)%VARIABLE_TYPE,err,error,*999)
881  CALL write_string_value(diagnostic_output_type," Number of columns = ",linear_mapping% &
882  & equations_matrix_to_var_maps(matrix_idx)%NUMBER_OF_COLUMNS,err,error,*999)
883  CALL write_string_value(diagnostic_output_type," Matrix coefficient = ",linear_mapping% &
884  & equations_matrix_to_var_maps(matrix_idx)%MATRIX_COEFFICIENT,err,error,*999)
885  CALL write_string_vector(diagnostic_output_type,1,1,linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)% &
886  & number_of_columns,5,5,linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_TO_DOF_MAP, &
887  & '(" Column to DOF maps :",5(X,I13))','(28X,5(X,I13))',err,error,*999)
888  ENDDO !matrix_idx
889  CALL write_string(diagnostic_output_type," Row mappings:",err,error,*999)
890  DO variable_idx=1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES
891  CALL write_string_value(diagnostic_output_type," Variable number : ",variable_idx,err,error,*999)
892  CALL write_string_vector(diagnostic_output_type,1,1,equations_mapping%TOTAL_NUMBER_OF_ROWS,5,5, &
893  & linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS(:,variable_idx), &
894  & '(" Row to DOF maps :",5(X,I13))','(21X,5(X,I13))',err,error,*999)
895  ENDDO !variable_idx
896  ENDIF
897  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
898  IF(ASSOCIATED(nonlinear_mapping)) THEN
899  CALL write_string(diagnostic_output_type," Nonlinear mappings:",err,error,*999)
900  DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
901  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
902  CALL write_string_value(diagnostic_output_type," Residual variable type = ",nonlinear_mapping% &
903  & jacobian_to_var_map(matrix_idx)%VARIABLE_TYPE,err,error,*999)
904  CALL write_string_value(diagnostic_output_type," Total number of residual DOFs = ",nonlinear_mapping% &
905  & jacobian_to_var_map(matrix_idx)%VARIABLE%TOTAL_NUMBER_OF_DOFS,err,error,*999)
906  ENDDO
907  CALL write_string_value(diagnostic_output_type," Residual coefficient = ",nonlinear_mapping%RESIDUAL_COEFFICIENT, &
908  & err,error,*999)
909  CALL write_string(diagnostic_output_type," Residual row mappings:",err,error,*999)
910  CALL write_string_vector(diagnostic_output_type,1,1,equations_mapping%TOTAL_NUMBER_OF_ROWS,5,5, &
911  & nonlinear_mapping%EQUATIONS_ROW_TO_RESIDUAL_DOF_MAP,'(" Row to DOF mappings :",5(X,I13))','(25X,5(X,I13))', &
912  & err,error,*999)
913  CALL write_string(diagnostic_output_type," Jacobian mappings:",err,error,*999)
914  CALL write_string(diagnostic_output_type," Variable to Jacobian mappings:",err,error,*999)
915  DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
916  CALL write_string_value(diagnostic_output_type," Matrix number : ",matrix_idx,err,error,*999)
917  CALL write_string_value(diagnostic_output_type," Jacobian variable type = ",nonlinear_mapping% &
918  & var_to_jacobian_map(matrix_idx)%VARIABLE_TYPE,err,error,*999)
919  CALL write_string_value(diagnostic_output_type," Total number of Jacobain DOFs = ",nonlinear_mapping% &
920  & var_to_jacobian_map(matrix_idx)%VARIABLE%TOTAL_NUMBER_OF_DOFS,err,error,*999)
921  CALL write_string_vector(diagnostic_output_type,1,1,nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%VARIABLE% &
922  & total_number_of_dofs,5,5,nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_COLUMNS_MAP, &
923  & '(" DOF to column map :",5(X,I13))','(26X,5(X,I13))',err,error,*999)
924  CALL write_string_vector(diagnostic_output_type,1,1,nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%VARIABLE% &
925  & total_number_of_dofs,5,5,nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx)%DOF_TO_ROWS_MAP, &
926  & '(" DOF to row map :",5(X,I13))','(26X,5(X,I13))',err,error,*999)
927  CALL write_string(diagnostic_output_type," Jacobian to variable mappings:",err,error,*999)
928  CALL write_string_value(diagnostic_output_type," Jacobian variable type = ",nonlinear_mapping% &
929  & jacobian_to_var_map(matrix_idx)%VARIABLE_TYPE,err,error,*999)
930  CALL write_string_value(diagnostic_output_type," Number of columns = ",nonlinear_mapping% &
931  & jacobian_to_var_map(matrix_idx)%NUMBER_OF_COLUMNS,err,error,*999)
932  CALL write_string_value(diagnostic_output_type," Jacobian coefficient = ",nonlinear_mapping% &
933  & jacobian_to_var_map(matrix_idx)%JACOBIAN_COEFFICIENT,err,error,*999)
934  CALL write_string_vector(diagnostic_output_type,1,1,nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%NUMBER_OF_COLUMNS, &
935  & 5,5,nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP, &
936  & '(" Column to DOF map :",5(X,I13))','(26X,5(X,I13))',err,error,*999)
937  ENDDO
938  ENDIF
939  rhs_mapping=>equations_mapping%RHS_MAPPING
940  IF(ASSOCIATED(rhs_mapping)) THEN
941  CALL write_string(diagnostic_output_type," RHS mappings:",err,error,*999)
942  CALL write_string_value(diagnostic_output_type," RHS variable type = ",rhs_mapping%RHS_VARIABLE_TYPE,err,error,*999)
943  CALL write_string_value(diagnostic_output_type," Total number of RHS DOFs = ",rhs_mapping%RHS_VARIABLE% &
944  & total_number_of_dofs,err,error,*999)
945  CALL write_string_value(diagnostic_output_type," RHS coefficient = ",rhs_mapping%RHS_COEFFICIENT,err,error,*999)
946  CALL write_string(diagnostic_output_type," Row mappings:",err,error,*999)
947  CALL write_string_vector(diagnostic_output_type,1,1,rhs_mapping%RHS_VARIABLE%TOTAL_NUMBER_OF_DOFS,5,5, &
948  & rhs_mapping%RHS_DOF_TO_EQUATIONS_ROW_MAP,'(" DOF to row mappings :",5(X,I13))','(25X,5(X,I13))',err,error,*999)
949  CALL write_string_vector(diagnostic_output_type,1,1,equations_mapping%TOTAL_NUMBER_OF_ROWS,5,5, &
950  & rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP,'(" Row to DOF mappings :",5(X,I13))','(25X,5(X,I13))',err,error,*999)
951  ENDIF
952  source_mapping=>equations_mapping%SOURCE_MAPPING
953  IF(ASSOCIATED(source_mapping)) THEN
954  CALL write_string(diagnostic_output_type," Source mappings:",err,error,*999)
955  CALL write_string_value(diagnostic_output_type," Source variable type = ",source_mapping%SOURCE_VARIABLE_TYPE, &
956  & err,error,*999)
957  CALL write_string_value(diagnostic_output_type," Total number of source DOFs = ",source_mapping%SOURCE_VARIABLE% &
958  & total_number_of_dofs,err,error,*999)
959  CALL write_string_value(diagnostic_output_type," Source coefficient = ",source_mapping%SOURCE_COEFFICIENT,err,error,*999)
960  !CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE," Row mappings:",ERR,ERROR,*999)
961  !CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,SOURCE_MAPPING%SOURCE_VARIABLE%TOTAL_NUMBER_OF_DOFS,5,5, &
962  ! & SOURCE_MAPPING%SOURCE_DOF_TO_EQUATIONS_ROW_MAP,'(" DOF to row mappings :",5(X,I13))','(25X,5(X,I13))', &
963  ! & ERR,ERROR,*999)
964  !CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,EQUATIONS_MAPPING%TOTAL_NUMBER_OF_ROWS,5,5, &
965  ! & SOURCE_MAPPING%EQUATIONS_ROW_TO_SOURCE_DOF_MAP,'(" Row to DOF mappings :",5(X,I13))','(25X,5(X,I13))', &
966  ! & ERR,ERROR,*999)
967  ENDIF
968  ENDIF
969 
970  exits("EQUATIONS_MAPPING_CALCULATE")
971  RETURN
972 999 errorsexits("EQUATIONS_MAPPING_CALCULATE",err,error)
973  RETURN 1
974  END SUBROUTINE equations_mapping_calculate
975 
976  !
977  !================================================================================================================================
978  !
979 
981  SUBROUTINE equations_mapping_create_finish(EQUATIONS_MAPPING,ERR,ERROR,*)
983  !Argument variables
984  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
985  INTEGER(INTG), INTENT(OUT) :: ERR
986  TYPE(varying_string), INTENT(OUT) :: ERROR
987  !Local Variables
988  INTEGER(INTG) :: matrix_idx
989  LOGICAL :: IS_RESIDUAL_TYPE
990  TYPE(equations_type), POINTER :: EQUATIONS
991  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
992  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
993  TYPE(varying_string) :: LOCAL_ERROR
994 
995  enters("EQUATIONS_MAPPING_CREATE_FINISH",err,error,*999)
996 
997  IF(ASSOCIATED(equations_mapping)) THEN
998  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
999  CALL flagerror("Equations mapping has already been finished.",err,error,*999)
1000  ELSE
1001  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
1002  IF(ASSOCIATED(create_values_cache)) THEN
1003  equations=>equations_mapping%EQUATIONS
1004  IF(ASSOCIATED(equations)) THEN
1005  equations_set=>equations%EQUATIONS_SET
1006  IF(ASSOCIATED(equations_set)) THEN
1007  !Check that all the variables have been mapped properly
1008  SELECT CASE(equations%TIME_DEPENDENCE)
1010  SELECT CASE(equations%LINEARITY)
1012  IF(create_values_cache%RHS_VARIABLE_TYPE==0.AND.create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES==0) &
1013  & CALL flagerror("Invalid equations mapping. The RHS variable type must be set if there are no "// &
1014  & "linear matrices.",err,error,*999)
1015  CASE(equations_nonlinear)
1016  DO matrix_idx=1,create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
1017  IF(create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)==0) THEN
1018  local_error="Invalid equations mapping. The residual variable type is not set for Jacobian number "// &
1019  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
1020  CALL flagerror(local_error,err,error,*999)
1021  ENDIF
1022  ENDDO
1023  IF(create_values_cache%RHS_VARIABLE_TYPE==0.AND.create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES==0) &
1024  & CALL flagerror("Invalid equations mapping. The RHS variable type must be set if there are no "// &
1025  & "linear matrices.",err,error,*999)
1026  CASE DEFAULT
1027  local_error="The equations linearity type of "// &
1028  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
1029  CALL flagerror(local_error,err,error,*999)
1030  END SELECT
1032  SELECT CASE(equations%LINEARITY)
1034  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==0) CALL flagerror("Invalid equations mapping. "// &
1035  & "The dynamic variable type must be set for dynamic equations.", err,error,*999)
1036  IF(create_values_cache%RHS_VARIABLE_TYPE==0.AND.create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES==0) &
1037  & CALL flagerror("Invalid equations mapping. The RHS variable type must be set if there are no "// &
1038  & "linear matrices.",err,error,*999)
1039  CASE(equations_nonlinear)
1040 ! SEBK 19/08/2009 not sure about mapping here
1041 !|
1042  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==0) CALL flagerror("Invalid equations mapping. "// &
1043  & "The dynamic variable type must be set for dynamic equations.", err,error,*999)
1044  IF(create_values_cache%RHS_VARIABLE_TYPE==0.AND.create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES==0) &
1045  & CALL flagerror("Invalid equations mapping. The RHS variable type must be set if there are no "// &
1046  & "linear matrices.",err,error,*999)
1047  is_residual_type=.false.
1048  DO matrix_idx=1,create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
1049  IF(create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)==0) THEN
1050  local_error="Invalid equations mapping. The residual variable type is not set for Jacobian number "// &
1051  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
1052  CALL flagerror(local_error,err,error,*999)
1053  ENDIF
1054  IF(create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)==create_values_cache%DYNAMIC_VARIABLE_TYPE) THEN
1055  is_residual_type=.true.
1056  ENDIF
1057  ENDDO
1058  IF(is_residual_type.EQV..false.) THEN
1059  CALL flagerror("Invalid equations mapping. "// "The residual variable type must correspond to the &
1060  & dynamic variable type for nonlinear dynamic equations.", err,error,*999)
1061  ENDIF
1062 !|
1063 ! SEBK 19/08/2009 not sure about mapping here
1064  CASE DEFAULT
1065  local_error="The equations linearity type of "// &
1066  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
1067  CALL flagerror(local_error,err,error,*999)
1068  END SELECT
1069  CASE DEFAULT
1070  local_error="The equations time dependence type of "// &
1071  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
1072  CALL flagerror(local_error,err,error,*999)
1073  END SELECT
1074  !Check the linear matrices variable types
1075  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1076  IF(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==0) THEN
1077  local_error="Invalid equations mapping. The linear matrix variable type is not set for linear matrix number "//&
1078  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
1079  CALL flagerror(local_error,err,error,*999)
1080  ENDIF
1081  ENDDO !matrix_idx
1082  !Now calculate the equations mapping and clean up
1083  CALL equations_mapping_calculate(equations_mapping,err,error,*999)
1084  CALL equationsmapping_createvaluescachefinalise(equations_mapping%CREATE_VALUES_CACHE,err,error,*999)
1085  equations_mapping%EQUATIONS_MAPPING_FINISHED=.true.
1086  ELSE
1087  CALL flagerror("Equations equations set is not associated.",err,error,*999)
1088  ENDIF
1089  ELSE
1090  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1091  ENDIF
1092  ELSE
1093  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
1094  ENDIF
1095  ENDIF
1096  ELSE
1097  CALL flagerror("Equations mapping is not associated.",err,error,*999)
1098  ENDIF
1099 
1100  exits("EQUATIONS_MAPPING_CREATE_FINISH")
1101  RETURN
1102 999 errorsexits("EQUATIONS_MAPPING_CREATE_FINISH",err,error)
1103  RETURN 1
1104  END SUBROUTINE equations_mapping_create_finish
1105 
1106  !
1107  !================================================================================================================================
1108  !
1109 
1111  SUBROUTINE equations_mapping_create_start(EQUATIONS,EQUATIONS_MAPPING,ERR,ERROR,*)
1113  !Argument variables
1114  TYPE(equations_type), POINTER :: EQUATIONS
1115  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1116  INTEGER(INTG), INTENT(OUT) :: ERR
1117  TYPE(varying_string), INTENT(OUT) :: ERROR
1118  !Local Variables
1119 
1120  enters("EQUATIONS_MAPPING_CREATE_START",err,error,*999)
1121 
1122  IF(ASSOCIATED(equations)) THEN
1123  IF(equations%EQUATIONS_FINISHED) THEN
1124  IF(ASSOCIATED(equations_mapping)) THEN
1125  CALL flagerror("Equations mapping is already associated.",err,error,*999)
1126  ELSE
1127  NULLIFY(equations_mapping)
1128  CALL equations_mapping_initialise(equations,err,error,*999)
1129  equations_mapping=>equations%EQUATIONS_MAPPING
1130  ENDIF
1131  ELSE
1132  CALL flagerror("Equations has not been finished.",err,error,*999)
1133  ENDIF
1134  ELSE
1135  CALL flagerror("Equations is not associated.",err,error,*999)
1136  ENDIF
1137 
1138  exits("EQUATIONS_MAPPING_CREATE_START")
1139  RETURN
1140 999 errorsexits("EQUATIONS_MAPPING_CREATE_START",err,error)
1141  RETURN 1
1142  END SUBROUTINE equations_mapping_create_start
1143 
1144  !
1145  !================================================================================================================================
1146  !
1147 
1149  SUBROUTINE equationsmapping_createvaluescachefinalise(CREATE_VALUES_CACHE,ERR,ERROR,*)
1151  !Argument variables
1152  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1153  INTEGER(INTG), INTENT(OUT) :: ERR
1154  TYPE(varying_string), INTENT(OUT) :: ERROR
1155  !Local Variables
1156 
1157  enters("EquationsMapping_CreateValuesCacheFinalise",err,error,*999)
1158 
1159  IF(ASSOCIATED(create_values_cache)) THEN
1160  IF(ALLOCATED(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS)) DEALLOCATE(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS)
1161  IF(ALLOCATED(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES)) DEALLOCATE(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES)
1162  IF(ALLOCATED(create_values_cache%LINEAR_MATRIX_COEFFICIENTS)) DEALLOCATE(create_values_cache%LINEAR_MATRIX_COEFFICIENTS)
1163  IF(ALLOCATED(create_values_cache%RESIDUAL_VARIABLE_TYPES)) DEALLOCATE(create_values_cache%RESIDUAL_VARIABLE_TYPES)
1164  DEALLOCATE(create_values_cache)
1165  ENDIF
1166 
1167  exits("EquationsMapping_CreateValuesCacheFinalise")
1168  RETURN
1169 999 errorsexits("EquationsMapping_CreateValuesCacheFinalise",err,error)
1170  RETURN 1
1172 
1173  !
1174  !================================================================================================================================
1175  !
1176 
1178  SUBROUTINE equationsmapping_createvaluescacheinitialise(EQUATIONS_MAPPING,ERR,ERROR,*)
1180  !Argument variables
1181  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1182  INTEGER(INTG), INTENT(OUT) :: ERR
1183  TYPE(varying_string), INTENT(OUT) :: ERROR
1184  !Local Variables
1185  INTEGER(INTG) :: DUMMY_ERR,matrix_idx,matrix_idx2,VARIABLE_NUMBER
1186  LOGICAL :: IS_RESIDUAL_TYPE
1187  TYPE(equations_type), POINTER :: EQUATIONS
1188  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1189  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1190  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
1191 
1192  enters("EquationsMapping_CreateValuesCacheInitialise",err,error,*998)
1193 
1194  IF(ASSOCIATED(equations_mapping)) THEN
1195  IF(ASSOCIATED(equations_mapping%CREATE_VALUES_CACHE)) THEN
1196  CALL flagerror("Equations mapping create values cache is already associated.",err,error,*998)
1197  ELSE
1198  equations=>equations_mapping%EQUATIONS
1199  IF(ASSOCIATED(equations)) THEN
1200  equations_set=>equations%EQUATIONS_SET
1201  IF(ASSOCIATED(equations_set)) THEN
1202  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1203  IF(ASSOCIATED(dependent_field)) THEN
1204  !Allocate and initialise the create values cache
1205  ALLOCATE(equations_mapping%CREATE_VALUES_CACHE,stat=err)
1206  IF(err/=0) CALL flagerror("Could not allocate equations mapping create values cache.",err,error,*999)
1207  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=0
1208  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE=0
1209  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_STIFFNESS_MATRIX_NUMBER=0
1210  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_DAMPING_MATRIX_NUMBER=0
1211  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_MASS_MATRIX_NUMBER=0
1212  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=0
1213  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES=0
1214  equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_COEFFICIENT=1.0_dp
1215  equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE=0
1216  equations_mapping%CREATE_VALUES_CACHE%RHS_COEFFICIENT=1.0_dp
1217  equations_mapping%CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE=0
1218  equations_mapping%CREATE_VALUES_CACHE%SOURCE_COEFFICIENT=1.0_dp
1219  !Set the default equations mapping in the create values cache
1220  !First calculate how many linear and dynamic matrices we have and set the variable types for the dynamic, residual
1221  !and RHS variables
1222  IF(dependent_field%NUMBER_OF_VARIABLES==1) THEN
1223  SELECT CASE(equations%LINEARITY)
1225  CALL flagerror("Dependent field only has one variable which cannot be mapped to both an equations matrix "// &
1226  & "and rhs vector.",err,error,*999)
1227  CASE(equations_nonlinear)
1228  CALL flagerror("Dependent field only has one variable which cannot be mapped to both the residual "// &
1229  & "and rhs vector.",err,error,*999)
1230  CASE DEFAULT
1231  local_error="The equations linearity type of "// &
1232  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
1233  CALL flagerror(local_error,err,error,*999)
1234  END SELECT
1235  ELSE IF(dependent_field%NUMBER_OF_VARIABLES>1) THEN
1236  SELECT CASE(equations%TIME_DEPENDENCE)
1238  SELECT CASE(equations%LINEARITY)
1240  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=dependent_field%NUMBER_OF_VARIABLES-1
1241  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_deludeln_variable_type)%PTR)) THEN
1242  equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE=dependent_field% &
1243  & variable_type_map(field_deludeln_variable_type)%PTR%VARIABLE_TYPE
1244  ELSE
1245  CALL flagerror("Not implemented.",err,error,*999)
1246  ENDIF
1247  CASE(equations_nonlinear)
1248  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=0
1249  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES=1
1250  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_deludeln_variable_type)%PTR)) THEN
1251  equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE=dependent_field% &
1252  & variable_type_map(field_deludeln_variable_type)%PTR%VARIABLE_TYPE
1253  ELSE
1254  CALL flagerror("Not implemented.",err,error,*999)
1255  ENDIF
1256  CASE DEFAULT
1257  local_error="The equations linearity type of "// &
1258  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
1259  CALL flagerror(local_error,err,error,*999)
1260  END SELECT
1262  SELECT CASE(equations%LINEARITY)
1264  IF(equations%TIME_DEPENDENCE==equations_first_order_dynamic) THEN
1265  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=2
1266  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_STIFFNESS_MATRIX_NUMBER=1
1267  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_DAMPING_MATRIX_NUMBER=2
1268  ELSE
1269  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=3
1270  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_STIFFNESS_MATRIX_NUMBER=1
1271  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_DAMPING_MATRIX_NUMBER=2
1272  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_MASS_MATRIX_NUMBER=3
1273  ENDIF
1274  !EQUATIONS_MAPPING%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=DEPENDENT_FIELD%NUMBER_OF_VARIABLES-2
1275  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=0
1276  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR)) THEN
1277  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE=dependent_field% &
1278  & variable_type_map(field_u_variable_type)%PTR%VARIABLE_TYPE
1279  ELSE
1280  CALL flagerror("Not implemented.",err,error,*999)
1281  ENDIF
1282  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_deludeln_variable_type)%PTR)) THEN
1283  equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE=dependent_field% &
1284  & variable_type_map(field_deludeln_variable_type)%PTR%VARIABLE_TYPE
1285  ELSE
1286  CALL flagerror("Not implemented.",err,error,*999)
1287  ENDIF
1288  CASE(equations_nonlinear)
1289 ! SEBK 19/08/2009 not sure about mapping here
1290 !|
1291  IF(equations%TIME_DEPENDENCE==equations_first_order_dynamic) THEN
1292  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=2
1293  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_STIFFNESS_MATRIX_NUMBER=1
1294  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_DAMPING_MATRIX_NUMBER=2
1295  ELSE
1296  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=3
1297  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_STIFFNESS_MATRIX_NUMBER=1
1298  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_DAMPING_MATRIX_NUMBER=2
1299  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_MASS_MATRIX_NUMBER=3
1300  ENDIF
1301  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=0
1302  equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES=1
1303  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR)) THEN
1304  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE=dependent_field% &
1305  & variable_type_map(field_u_variable_type)%PTR%VARIABLE_TYPE
1306  ELSE
1307  CALL flagerror("Not implemented.",err,error,*999)
1308  ENDIF
1309  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_deludeln_variable_type)%PTR)) THEN
1310  equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE=dependent_field% &
1311  & variable_type_map(field_deludeln_variable_type)%PTR%VARIABLE_TYPE
1312  ELSE
1313  CALL flagerror("Not implemented.",err,error,*999)
1314  ENDIF
1315  CASE DEFAULT
1316  local_error="The equations linearity type of "// &
1317  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
1318  CALL flagerror(local_error,err,error,*999)
1319  END SELECT
1320 !|
1321 ! SEBK 19/08/2009 not sure about mapping here
1322  CASE DEFAULT
1323  local_error="The equations time dependence type of "// &
1324  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
1325  CALL flagerror(local_error,err,error,*999)
1326  END SELECT
1327  ELSE
1328  local_error="The number of dependent field variables of "// &
1329  & trim(numbertovstring(dependent_field%NUMBER_OF_VARIABLES,"*",err,error))//" is invalid."
1330  CALL flagerror(local_error,err,error,*999)
1331  ENDIF
1332  !Allocate the dynamic matrix coefficients and set their values
1333  IF(equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES>0) THEN
1334  ALLOCATE(equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_MATRIX_COEFFICIENTS(equations_mapping% &
1335  & create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES),stat=err)
1336  IF(err/=0) &
1337  & CALL flagerror("Could not allocate equations mapping create values cache dynamic matrix coefficients.", &
1338  & err,error,*999)
1339  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_MATRIX_COEFFICIENTS=1.0_dp !Equations matrices are added by default
1340  ENDIF
1341  !Allocate the residual variable types
1342  IF(equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES>0) THEN
1343  ALLOCATE(equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES(equations_mapping% &
1344  & create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
1345  IF(err/=0) CALL flagerror("Could not allocate equations mapping create values cache residual variable types.", &
1346  & err,error,*999)
1347  equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES=0
1348  DO matrix_idx=1,equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES
1349  variable_number=1
1350  DO WHILE(equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES(matrix_idx)==0.AND. &
1351  & variable_number<=field_number_of_variable_types)
1352  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR)) THEN
1353  IF(dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR%VARIABLE_TYPE/= &
1354  & equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE) THEN
1355  equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES(matrix_idx)= &
1356  & dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR%VARIABLE_TYPE
1357  ENDIF
1358  ENDIF
1359  variable_number=variable_number+1
1360  ENDDO
1361  ENDDO !matrix_idx
1362  IF(equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES(equations_mapping% &
1363  & create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES)==0) &
1364  & CALL flagerror("Invalid setup. All Jacobian matrices do not have a mapped dependent field variable.", &
1365  & err,error,*999)
1366  ENDIF
1367  !Allocate the linear matrix variable types and linear matrix coefficients and set their values
1368  IF(equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES>0) THEN
1369  ALLOCATE(equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_VARIABLE_TYPES(equations_mapping% &
1370  & create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
1371  IF(err/=0) CALL &
1372  & flag_error("Could not allocate equations mapping create values cache linear matrix variable types.", &
1373  & err,error,*999)
1374  ALLOCATE(equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_COEFFICIENTS(equations_mapping% &
1375  & create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
1376  IF(err/=0) CALL flagerror("Could not allocate equations mapping create values cache linear matrix coefficients.", &
1377  & err,error,*999)
1378  !Set up the matrices variable types
1379  equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_VARIABLE_TYPES=0
1380  variable_number=1
1381  DO matrix_idx=1,equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1382  DO WHILE(equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==0.AND. &
1383  & variable_number<=field_number_of_variable_types)
1384  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR)) THEN
1385  IF(dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR%VARIABLE_TYPE/= &
1386  & equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE) THEN
1387  is_residual_type=.false.
1388  DO matrix_idx2=1,equations_mapping%CREATE_VALUES_CACHE%NUMBER_OF_RESIDUAL_VARIABLES
1389  IF(dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR%VARIABLE_TYPE== &
1390  & equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_VARIABLE_TYPES(matrix_idx2)) THEN
1391  is_residual_type=.true.
1392  ENDIF
1393  ENDDO
1394  IF(is_residual_type.EQV..false.) THEN
1395  equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)= &
1396  & dependent_field%VARIABLE_TYPE_MAP(variable_number)%PTR%VARIABLE_TYPE
1397  ENDIF
1398  ENDIF
1399  ENDIF
1400  variable_number=variable_number+1
1401  ENDDO
1402  ENDDO !matrix_idx
1403  IF(equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_VARIABLE_TYPES(equations_mapping% &
1404  & create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)==0) &
1405  & CALL flagerror("Invalid setup. All linear matrices do not have a mapped dependent field variable.", &
1406  & err,error,*999)
1407  equations_mapping%CREATE_VALUES_CACHE%LINEAR_MATRIX_COEFFICIENTS=1.0_dp !Equations matrices are added by default
1408  ENDIF
1409  ELSE
1410  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1411  ENDIF
1412  ELSE
1413  CALL flagerror("The equations equations set is not associated.",err,error,*998)
1414  ENDIF
1415  ELSE
1416  CALL flagerror("The equations mapping equations is not associated.",err,error,*998)
1417  ENDIF
1418  ENDIF
1419  ELSE
1420  CALL flagerror("Equations mapping is not associated.",err,error,*998)
1421  ENDIF
1422 
1423  exits("EquationsMapping_CreateValuesCacheInitialise")
1424  RETURN
1425 999 CALL equationsmapping_createvaluescachefinalise(equations_mapping%CREATE_VALUES_CACHE,dummy_err,dummy_error,*998)
1426 998 errors("EquationsMapping_CreateValuesCacheInitialise",err,error)
1427  exits("EquationsMapping_CreateValuesCacheInitialise")
1428  RETURN 1
1429 
1431 
1432  !
1433  !================================================================================================================================
1434  !
1435 
1437  SUBROUTINE equations_mapping_destroy(EQUATIONS_MAPPING,ERR,ERROR,*)
1439  !Argument variables
1440  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1441  INTEGER(INTG), INTENT(OUT) :: ERR
1442  TYPE(varying_string), INTENT(OUT) :: ERROR
1443  !Local Variables
1444 
1445  enters("EQUATIONS_MAPPING_DESTROY",err,error,*999)
1446 
1447  IF(ASSOCIATED(equations_mapping)) THEN
1448  CALL equations_mapping_finalise(equations_mapping,err,error,*999)
1449  ELSE
1450  CALL flagerror("Equations mapping is not associated.",err,error,*999)
1451  ENDIF
1452 
1453  exits("EQUATIONS_MAPPING_DESTROY")
1454  RETURN
1455 999 errorsexits("EQUATIONS_MAPPING_DESTROY",err,error)
1456  RETURN 1
1457 
1458  END SUBROUTINE equations_mapping_destroy
1459 
1460  !
1461  !================================================================================================================================
1462  !
1463 
1465  SUBROUTINE equations_mapping_dynamic_mapping_finalise(DYNAMIC_MAPPING,ERR,ERROR,*)
1467  !Argument variables
1468  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
1469  INTEGER(INTG), INTENT(OUT) :: ERR
1470  TYPE(varying_string), INTENT(OUT) :: ERROR
1471  !Local Variables
1472  INTEGER(INTG) :: matrix_idx,variable_type
1473 
1474  enters("EQUATIONS_MAPPING_DYNAMIC_MAPPING_FINALISE",err,error,*999)
1475 
1476  IF(ASSOCIATED(dynamic_mapping)) THEN
1477  IF(ALLOCATED(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS)) THEN
1478  DO variable_type=1,SIZE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS,1)
1479  CALL equationsmapping_vartoequatsmatricesmapfinalise(dynamic_mapping% &
1480  & var_to_equations_matrices_maps(variable_type),err,error,*999)
1481  ENDDO !variable_type
1482  DEALLOCATE(dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS)
1483  ENDIF
1484  IF(ALLOCATED(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS)) THEN
1485  DO matrix_idx=1,SIZE(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS,1)
1486  CALL equationsmapping_equationsmatrixtovarmapfinalise(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx), &
1487  & err,error,*999)
1488  ENDDO !matrix_idx
1489  DEALLOCATE(dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS)
1490  ENDIF
1491  IF(ALLOCATED(dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS)) &
1492  & DEALLOCATE(dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS)
1493  DEALLOCATE(dynamic_mapping)
1494  ENDIF
1495 
1496  exits("EQUATIONS_MAPPING_DYNAMIC_MAPPING_FINALISE")
1497  RETURN
1498 999 errorsexits("EQUATIONS_MAPPING_DYNAMIC_MAPPING_FINALISE",err,error)
1499  RETURN 1
1500 
1502 
1503  !
1504  !================================================================================================================================
1505  !
1506 
1508  SUBROUTINE equationsmapping_dynamicmappinginitialise(EQUATIONS_MAPPING,ERR,ERROR,*)
1510  !Argument variables
1511  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1512  INTEGER(INTG), INTENT(OUT) :: ERR
1513  TYPE(varying_string), INTENT(OUT) :: ERROR
1514  !Local Variables
1515  INTEGER(INTG) :: DUMMY_ERR
1516  TYPE(varying_string) :: DUMMY_ERROR
1517 
1518  enters("EquationsMapping_DynamicMappingInitialise",err,error,*998)
1519 
1520  IF(ASSOCIATED(equations_mapping)) THEN
1521  IF(ASSOCIATED(equations_mapping%DYNAMIC_MAPPING)) THEN
1522  CALL flagerror("Equations mapping dynamic mapping is already associated.",err,error,*998)
1523  ELSE
1524  ALLOCATE(equations_mapping%DYNAMIC_MAPPING,stat=err)
1525  IF(err/=0) CALL flagerror("Could not allocate equations mapping dynamic mapping.",err,error,*999)
1526  equations_mapping%DYNAMIC_MAPPING%EQUATIONS_MAPPING=>equations_mapping
1527  equations_mapping%DYNAMIC_MAPPING%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=0
1528  equations_mapping%DYNAMIC_MAPPING%STIFFNESS_MATRIX_NUMBER=0
1529  equations_mapping%DYNAMIC_MAPPING%DAMPING_MATRIX_NUMBER=0
1530  equations_mapping%DYNAMIC_MAPPING%MASS_MATRIX_NUMBER=0
1531  equations_mapping%DYNAMIC_MAPPING%DYNAMIC_VARIABLE_TYPE=0
1532  NULLIFY(equations_mapping%DYNAMIC_MAPPING%DYNAMIC_VARIABLE)
1533  ENDIF
1534  ELSE
1535  CALL flagerror("Equations mapping is not associated.",err,error,*998)
1536  ENDIF
1537 
1538  exits("EquationsMapping_DynamicMappingInitialise")
1539  RETURN
1540 999 CALL equations_mapping_dynamic_mapping_finalise(equations_mapping%DYNAMIC_MAPPING,dummy_err,dummy_error,*998)
1541 998 errorsexits("EquationsMapping_DynamicMappingInitialise",err,error)
1542  RETURN 1
1543 
1545 
1546  !
1547  !================================================================================================================================
1548  !
1549 
1551  SUBROUTINE equations_mapping_dynamic_matrices_set_all(EQUATIONS_MAPPING,MASS_MATRIX,DAMPING_MATRIX,STIFFNESS_MATRIX, &
1552  & err,error,*)
1554  !Argument variables
1555  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1556  LOGICAL, INTENT(IN) :: MASS_MATRIX
1557  LOGICAL, INTENT(IN) :: DAMPING_MATRIX
1558  LOGICAL, INTENT(IN) :: STIFFNESS_MATRIX
1559  INTEGER(INTG), INTENT(OUT) :: ERR
1560  TYPE(varying_string), INTENT(OUT) :: ERROR
1561  !Local Variables
1562  INTEGER(INTG) :: NEW_DYNAMIC_DAMPING_MATRIX_NUMBER,NEW_DYNAMIC_MASS_MATRIX_NUMBER,NEW_DYNAMIC_STIFFNESS_MATRIX_NUMBER, &
1563  & NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
1564  REAL(DP), ALLOCATABLE :: OLD_DYNAMIC_MATRIX_COEFFICIENTS(:)
1565  TYPE(equations_type), POINTER :: EQUATIONS
1566  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1567  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1568  TYPE(varying_string) :: LOCAL_ERROR
1569 
1570  enters("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_ALL",err,error,*999)
1571 
1572  IF(ASSOCIATED(equations_mapping)) THEN
1573  equations=>equations_mapping%EQUATIONS
1574  IF(ASSOCIATED(equations)) THEN
1575  equations_set=>equations%EQUATIONS_SET
1576  IF(ASSOCIATED(equations_set)) THEN
1577  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
1578  IF(ASSOCIATED(create_values_cache)) THEN
1579  SELECT CASE(equations%LINEARITY)
1581  number_of_dynamic_equations_matrices=0
1582  new_dynamic_stiffness_matrix_number=0
1583  new_dynamic_damping_matrix_number=0
1584  new_dynamic_mass_matrix_number=0
1585  IF(stiffness_matrix) THEN
1586  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1587  new_dynamic_stiffness_matrix_number=number_of_dynamic_equations_matrices
1588  ENDIF
1589  IF(damping_matrix) THEN
1590  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1591  new_dynamic_damping_matrix_number=number_of_dynamic_equations_matrices
1592  ENDIF
1593  IF(mass_matrix) THEN
1594  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1595  new_dynamic_mass_matrix_number=number_of_dynamic_equations_matrices
1596  ENDIF
1597  IF(number_of_dynamic_equations_matrices>0) THEN
1598  ALLOCATE(old_dynamic_matrix_coefficients(create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES),stat=err)
1599  IF(err/=0) CALL flagerror("Could not allocate old dynamic matrix coefficients.",err,error,*999)
1600  old_dynamic_matrix_coefficients(1:create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES)= &
1601  & create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES)
1602  DEALLOCATE(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS)
1603  ALLOCATE(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(number_of_dynamic_equations_matrices),stat=err)
1604  IF(err/=0) CALL flagerror("Could not allocate dynamic matrix coefficients.",err,error,*999)
1605  IF(new_dynamic_stiffness_matrix_number/=0) THEN
1606  IF(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER==0) THEN
1607  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_stiffness_matrix_number)=1.0_dp
1608  ELSE
1609  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_stiffness_matrix_number)= &
1610  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER)
1611  ENDIF
1612  ENDIF
1613  IF(new_dynamic_damping_matrix_number/=0) THEN
1614  IF(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER==0) THEN
1615  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_damping_matrix_number)=1.0_dp
1616  ELSE
1617  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_damping_matrix_number)= &
1618  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER)
1619  ENDIF
1620  ENDIF
1621  IF(new_dynamic_mass_matrix_number/=0) THEN
1622  IF(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER==0) THEN
1623  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_mass_matrix_number)=1.0_dp
1624  ELSE
1625  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_mass_matrix_number)= &
1626  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER)
1627  ENDIF
1628  ENDIF
1629  create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=number_of_dynamic_equations_matrices
1630  create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER=new_dynamic_stiffness_matrix_number
1631  create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER=new_dynamic_damping_matrix_number
1632  create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER=new_dynamic_mass_matrix_number
1633  IF(ALLOCATED(old_dynamic_matrix_coefficients)) DEALLOCATE(old_dynamic_matrix_coefficients)
1634  ELSE
1635  CALL flagerror("Invalid dynamic matrices set up. There are no dynamic equations matrices.",err,error,*999)
1636  ENDIF
1637  CASE(equations_nonlinear)
1638 ! SEBK 19/08/2009 not sure about mapping here
1639 !|
1640  number_of_dynamic_equations_matrices=0
1641  new_dynamic_stiffness_matrix_number=0
1642  new_dynamic_damping_matrix_number=0
1643  new_dynamic_mass_matrix_number=0
1644  IF(stiffness_matrix) THEN
1645  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1646  new_dynamic_stiffness_matrix_number=number_of_dynamic_equations_matrices
1647  ENDIF
1648  IF(damping_matrix) THEN
1649  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1650  new_dynamic_damping_matrix_number=number_of_dynamic_equations_matrices
1651  ENDIF
1652  IF(mass_matrix) THEN
1653  number_of_dynamic_equations_matrices=number_of_dynamic_equations_matrices+1
1654  new_dynamic_mass_matrix_number=number_of_dynamic_equations_matrices
1655  ENDIF
1656  IF(number_of_dynamic_equations_matrices>0) THEN
1657  ALLOCATE(old_dynamic_matrix_coefficients(create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES),stat=err)
1658  IF(err/=0) CALL flagerror("Could not allocate old dynamic matrix coefficients.",err,error,*999)
1659  old_dynamic_matrix_coefficients(1:create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES)= &
1660  & create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES)
1661  DEALLOCATE(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS)
1662  ALLOCATE(create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(number_of_dynamic_equations_matrices),stat=err)
1663  IF(err/=0) CALL flagerror("Could not allocate dynamic matrix coefficients.",err,error,*999)
1664  IF(new_dynamic_stiffness_matrix_number/=0) THEN
1665  IF(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER==0) THEN
1666  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_stiffness_matrix_number)=1.0_dp
1667  ELSE
1668  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_stiffness_matrix_number)= &
1669  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER)
1670  ENDIF
1671  ENDIF
1672  IF(new_dynamic_damping_matrix_number/=0) THEN
1673  IF(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER==0) THEN
1674  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_damping_matrix_number)=1.0_dp
1675  ELSE
1676  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_damping_matrix_number)= &
1677  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER)
1678  ENDIF
1679  ENDIF
1680  IF(new_dynamic_mass_matrix_number/=0) THEN
1681  IF(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER==0) THEN
1682  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_mass_matrix_number)=1.0_dp
1683  ELSE
1684  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(new_dynamic_mass_matrix_number)= &
1685  & old_dynamic_matrix_coefficients(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER)
1686  ENDIF
1687  ENDIF
1688  create_values_cache%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES=number_of_dynamic_equations_matrices
1689  create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER=new_dynamic_stiffness_matrix_number
1690  create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER=new_dynamic_damping_matrix_number
1691  create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER=new_dynamic_mass_matrix_number
1692  IF(ALLOCATED(old_dynamic_matrix_coefficients)) DEALLOCATE(old_dynamic_matrix_coefficients)
1693  ELSE
1694  CALL flagerror("Invalid dynamic matrices set up. There are no dynamic equations matrices.",err,error,*999)
1695  ENDIF
1696 !|
1697 ! SEBK 19/08/2009 not sure about mapping here
1698  CASE DEFAULT
1699  local_error="The equations linearity type of "//trim(numbertovstring(equations%LINEARITY,"*",err,error))// &
1700  & " is invalid."
1701  CALL flagerror(local_error,err,error,*999)
1702  END SELECT
1703  ELSE
1704  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
1705  ENDIF
1706  ELSE
1707  CALL flagerror("Equations equations set is not associated.",err,error,*999)
1708  ENDIF
1709  ELSE
1710  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1711  ENDIF
1712  ELSE
1713  CALL flagerror("Equations is not associated.",err,error,*999)
1714  ENDIF
1715 
1716  exits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_ALL_ORDER")
1717  RETURN
1718 999 IF(ALLOCATED(old_dynamic_matrix_coefficients)) DEALLOCATE(old_dynamic_matrix_coefficients)
1719  errorsexits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_ALL",err,error)
1720  RETURN 1
1721 
1723 
1724  !
1725  !================================================================================================================================
1726  !
1727 
1729  SUBROUTINE equations_mapping_dynamic_matrices_set_1(EQUATIONS_MAPPING,DAMPING_MATRIX,STIFFNESS_MATRIX,ERR,ERROR,*)
1731  !Argument variables
1732  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1733  LOGICAL, INTENT(IN) :: DAMPING_MATRIX
1734  LOGICAL, INTENT(IN) :: STIFFNESS_MATRIX
1735  INTEGER(INTG), INTENT(OUT) :: ERR
1736  TYPE(varying_string), INTENT(OUT) :: ERROR
1737  !Local Variables
1738  TYPE(equations_type), POINTER :: EQUATIONS
1739  TYPE(varying_string) :: LOCAL_ERROR
1740 
1741  enters("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_1",err,error,*999)
1742 
1743  IF(ASSOCIATED(equations_mapping)) THEN
1744  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
1745  CALL flagerror("Equations mapping has already been finished.",err,error,*999)
1746  ELSE
1747  equations=>equations_mapping%EQUATIONS
1748  IF(ASSOCIATED(equations)) THEN
1749  SELECT CASE(equations%TIME_DEPENDENCE)
1750  CASE(equations_static)
1751  CALL flagerror("Can not set dynamic matrices for static equations.",err,error,*999)
1752  CASE(equations_quasistatic)
1753  CALL flagerror("Can not set dynamic matrices for quasi-static equations.",err,error,*999)
1755  IF(.NOT.damping_matrix) CALL flag_warning("No damping matrix for first order dynamic equations.",err,error,*999)
1756  CALL equations_mapping_dynamic_matrices_set_all(equations_mapping,.false.,damping_matrix,stiffness_matrix, &
1757  err,error,*999)
1759  CALL flagerror("Need to specify three matrices to set for second order dynamic equations.",err,error,*999)
1760  CASE DEFAULT
1761  local_error="The equations time dependence type of "// &
1762  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
1763  & " is invalid."
1764  CALL flagerror(local_error,err,error,*999)
1765  END SELECT
1766  ELSE
1767  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1768  ENDIF
1769  ENDIF
1770  ELSE
1771  CALL flagerror("Equations is not associated.",err,error,*999)
1772  ENDIF
1773 
1774  exits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_1")
1775  RETURN
1776 999 errorsexits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_1",err,error)
1777  RETURN 1
1778 
1780 
1781  !
1782  !================================================================================================================================
1783  !
1784 
1786  SUBROUTINE equations_mapping_dynamic_matrices_set_2(EQUATIONS_MAPPING,MASS_MATRIX,DAMPING_MATRIX,STIFFNESS_MATRIX, &
1787  & err,error,*)
1789  !Argument variables
1790  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1791  LOGICAL, INTENT(IN) :: MASS_MATRIX
1792  LOGICAL, INTENT(IN) :: DAMPING_MATRIX
1793  LOGICAL, INTENT(IN) :: STIFFNESS_MATRIX
1794  INTEGER(INTG), INTENT(OUT) :: ERR
1795  TYPE(varying_string), INTENT(OUT) :: ERROR
1796  !Local Variables
1797  TYPE(equations_type), POINTER :: EQUATIONS
1798  TYPE(varying_string) :: LOCAL_ERROR
1799 
1800  enters("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_2",err,error,*999)
1801 
1802  IF(ASSOCIATED(equations_mapping)) THEN
1803  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
1804  CALL flagerror("Equations mapping has already been finished.",err,error,*999)
1805  ELSE
1806  equations=>equations_mapping%EQUATIONS
1807  IF(ASSOCIATED(equations)) THEN
1808  SELECT CASE(equations%TIME_DEPENDENCE)
1809  CASE(equations_static)
1810  CALL flagerror("Can not set dynamic matrices for static equations.",err,error,*999)
1811  CASE(equations_quasistatic)
1812  CALL flagerror("Can not set dynamic matrices for quasi-static equations.",err,error,*999)
1814  IF(mass_matrix) THEN
1815  CALL flagerror("The mass matrix cannot be present for first order dynamic equations.",err,error,*999)
1816  ELSE
1817  IF(.NOT.damping_matrix) CALL flag_warning("No damping matrix for a first order dynamic system.",err,error,*999)
1818  CALL equations_mapping_dynamic_matrices_set_all(equations_mapping,.false.,damping_matrix,stiffness_matrix, &
1819  err,error,*999)
1820  ENDIF
1822  IF(.NOT.mass_matrix) CALL flag_warning("No mass matrix for a second order dynamic system.",err,error,*999)
1823  CALL equations_mapping_dynamic_matrices_set_all(equations_mapping,mass_matrix,damping_matrix, &
1824  & stiffness_matrix,err,error,*999)
1825  CASE DEFAULT
1826  local_error="The equations time dependence type of "// &
1827  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
1828  & " is invalid."
1829  CALL flagerror(local_error,err,error,*999)
1830  END SELECT
1831  ELSE
1832  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1833  ENDIF
1834  ENDIF
1835  ELSE
1836  CALL flagerror("Equations is not associated.",err,error,*999)
1837  ENDIF
1838 
1839  exits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_2")
1840  RETURN
1841 999 errorsexits("EQUATIONS_MAPPING_DYNAMIC_MATRICES_SET_2",err,error)
1842  RETURN 1
1843 
1845 
1846  !
1847  !================================================================================================================================
1848  !
1849 
1851  SUBROUTINE equationsmapping_dynamicmatricescoeffsset1(EQUATIONS_MAPPING,DAMPING_MATRIX_COEFFICIENT, &
1852  & stiffness_matrix_coefficient,err,error,*)
1854  !Argument variables
1855  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1856  REAL(DP), INTENT(IN) :: DAMPING_MATRIX_COEFFICIENT
1857  REAL(DP), INTENT(IN) :: STIFFNESS_MATRIX_COEFFICIENT
1858  INTEGER(INTG), INTENT(OUT) :: ERR
1859  TYPE(varying_string), INTENT(OUT) :: ERROR
1860  !Local Variables
1861  TYPE(equations_type), POINTER :: EQUATIONS
1862  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1863  TYPE(varying_string) :: LOCAL_ERROR
1864 
1865  enters("EquationsMapping_DynamicMatricesCoeffsSet1",err,error,*999)
1866 
1867  IF(ASSOCIATED(equations_mapping)) THEN
1868  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
1869  CALL flagerror("Equations mapping has already been finished.",err,error,*999)
1870  ELSE
1871  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
1872  IF(ASSOCIATED(create_values_cache)) THEN
1873  equations=>equations_mapping%EQUATIONS
1874  IF(ASSOCIATED(equations)) THEN
1875  SELECT CASE(equations%TIME_DEPENDENCE)
1876  CASE(equations_static)
1877  CALL flagerror("Can not set dynamic matrix coefficients for static equations.",err,error,*999)
1878  CASE(equations_quasistatic)
1879  CALL flagerror("Can not set dynamic matrix coefficients for quasi-static equations.",err,error,*999)
1881  IF(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER/=0) THEN
1882  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER)= &
1883  & stiffness_matrix_coefficient
1884  ENDIF
1885  IF(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER/=0) THEN
1886  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER)= &
1887  & damping_matrix_coefficient
1888  ENDIF
1890  CALL flagerror("Need to specify three matrix coefficients for second order dynamic equations.", &
1891  & err,error,*999)
1892  CASE DEFAULT
1893  local_error="The equations time dependence type of "// &
1894  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
1895  & " is invalid."
1896  CALL flagerror(local_error,err,error,*999)
1897  END SELECT
1898  ELSE
1899  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1900  ENDIF
1901  ELSE
1902  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
1903  ENDIF
1904  ENDIF
1905  ELSE
1906  CALL flagerror("Equations is not associated.",err,error,*999)
1907  ENDIF
1908 
1909  exits("EquationsMapping_DynamicMatricesCoeffsSet1")
1910  RETURN
1911 999 errorsexits("EquationsMapping_DynamicMatricesCoeffsSet1",err,error)
1912  RETURN 1
1913 
1915 
1916  !
1917  !================================================================================================================================
1918  !
1919 
1921  SUBROUTINE equationsmapping_dynamicmatricescoeffsset2(EQUATIONS_MAPPING,MASS_MATRIX_COEFFICIENT, &
1922  & damping_matrix_coefficient,stiffness_matrix_coefficient,err,error,*)
1924  !Argument variables
1925  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1926  REAL(DP), INTENT(IN) :: MASS_MATRIX_COEFFICIENT
1927  REAL(DP), INTENT(IN) :: DAMPING_MATRIX_COEFFICIENT
1928  REAL(DP), INTENT(IN) :: STIFFNESS_MATRIX_COEFFICIENT
1929  INTEGER(INTG), INTENT(OUT) :: ERR
1930  TYPE(varying_string), INTENT(OUT) :: ERROR
1931  !Local Variables
1932  TYPE(equations_type), POINTER :: EQUATIONS
1933  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1934  TYPE(varying_string) :: LOCAL_ERROR
1935 
1936  enters("EquationsMapping_DynamicMatricesCoeffsSet2",err,error,*999)
1937 
1938  IF(ASSOCIATED(equations_mapping)) THEN
1939  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
1940  CALL flagerror("Equations mapping has already been finished.",err,error,*999)
1941  ELSE
1942  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
1943  IF(ASSOCIATED(create_values_cache)) THEN
1944  equations=>equations_mapping%EQUATIONS
1945  IF(ASSOCIATED(equations)) THEN
1946  SELECT CASE(equations%TIME_DEPENDENCE)
1947  CASE(equations_static)
1948  CALL flagerror("Can not set dynamic matrices for static equations.",err,error,*999)
1949  CASE(equations_quasistatic)
1950  CALL flagerror("Can not set dynamic matrices for quasi-static equations.",err,error,*999)
1952  CALL flagerror("Need to specify two matrix coefficients for second order dynamic equations.",err,error,*999)
1954  IF(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER/=0) THEN
1955  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(create_values_cache%DYNAMIC_STIFFNESS_MATRIX_NUMBER)= &
1956  & stiffness_matrix_coefficient
1957  ENDIF
1958  IF(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER/=0) THEN
1959  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(create_values_cache%DYNAMIC_DAMPING_MATRIX_NUMBER)= &
1960  & damping_matrix_coefficient
1961  ENDIF
1962  IF(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER/=0) THEN
1963  create_values_cache%DYNAMIC_MATRIX_COEFFICIENTS(create_values_cache%DYNAMIC_MASS_MATRIX_NUMBER)= &
1964  & mass_matrix_coefficient
1965  ENDIF
1966  CASE DEFAULT
1967  local_error="The equations time dependence type of "// &
1968  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
1969  & " is invalid."
1970  CALL flagerror(local_error,err,error,*999)
1971  END SELECT
1972  ELSE
1973  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
1974  ENDIF
1975  ELSE
1976  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
1977  ENDIF
1978  ENDIF
1979  ELSE
1980  CALL flagerror("Equations is not associated.",err,error,*999)
1981  ENDIF
1982 
1983  exits("EquationsMapping_DynamicMatricesCoeffsSet2")
1984  RETURN
1985 999 errorsexits("EquationsMapping_DynamicMatricesCoeffsSet2",err,error)
1986  RETURN 1
1987 
1989 
1990  !
1991  !================================================================================================================================
1992  !
1993 
1995  SUBROUTINE equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING,DYNAMIC_VARIABLE_TYPE,ERR,ERROR,*)
1997  !Argument variables
1998  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1999  INTEGER(INTG), INTENT(IN) :: DYNAMIC_VARIABLE_TYPE
2000  INTEGER(INTG), INTENT(OUT) :: ERR
2001  TYPE(varying_string), INTENT(OUT) :: ERROR
2002  !Local Variables
2003  INTEGER(INTG) :: matrix_idx
2004  TYPE(equations_type), POINTER :: EQUATIONS
2005  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2006  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2007  TYPE(field_type), POINTER :: DEPENDENT_FIELD
2008  TYPE(varying_string) :: LOCAL_ERROR
2009  LOGICAL :: IS_RESIDUAL_TYPE
2010 
2011  enters("EQUATIONS_MAPPING_DYNAMIC_VARIABLE_TYPE_SET",err,error,*999)
2012 
2013  IF(ASSOCIATED(equations_mapping)) THEN
2014  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2015  CALL flagerror("Equations mapping have been finished.",err,error,*999)
2016  ELSE
2017  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2018  IF(ASSOCIATED(create_values_cache)) THEN
2019  IF(dynamic_variable_type==0) THEN
2020  create_values_cache%DYNAMIC_VARIABLE_TYPE=0
2021  ELSE
2022  equations=>equations_mapping%EQUATIONS
2023  IF(ASSOCIATED(equations)) THEN
2024  equations_set=>equations%EQUATIONS_SET
2025  IF(ASSOCIATED(equations_set)) THEN
2026  IF(equations%TIME_DEPENDENCE==equations_first_order_dynamic.OR. &
2027  equations%TIME_DEPENDENCE==equations_second_order_dynamic) THEN
2028  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2029  IF(ASSOCIATED(dependent_field)) THEN
2030  !Check the dynamic variable type is not being by other equations matrices or vectors
2031  IF(equations%LINEARITY==equations_nonlinear) THEN
2032  is_residual_type=.false.
2033  DO matrix_idx=1,create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
2034  IF(create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)==dynamic_variable_type) THEN
2035  is_residual_type=.true.
2036  ENDIF
2037  ENDDO
2038  IF(is_residual_type.NEQV..true.) THEN
2039  local_error="The specified dynamic variable type of "// &
2040  & trim(numbertovstring(dynamic_variable_type,"*",err,error))// &
2041  & " is not the same as any residual variable type."
2042  CALL flagerror(local_error,err,error,*999)
2043  ENDIF
2044  END IF
2045  IF(create_values_cache%RHS_VARIABLE_TYPE==dynamic_variable_type) THEN
2046  local_error="The specified dynamic variable type of "// &
2047  & trim(numbertovstring(dynamic_variable_type,"*",err,error))// &
2048  & " is the same as the variable type for the RHS vector."
2049  CALL flagerror(local_error,err,error,*999)
2050  ENDIF
2051  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2052  IF(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==dynamic_variable_type) THEN
2053  local_error="The specified dynamic variable type of "// &
2054  & trim(numbertovstring(dynamic_variable_type,"*",err,error))// &
2055  & " is the same as the variable type for linear matrix number "// &
2056  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
2057  CALL flagerror(local_error,err,error,*999)
2058  ENDIF
2059  ENDDO !matrix_idx
2060  !Check the dynamic variable type is defined on the dependent field
2061  IF(dynamic_variable_type>=1.AND.dynamic_variable_type<=field_number_of_variable_types) THEN
2062  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(dynamic_variable_type)%PTR)) THEN
2063  equations_mapping%CREATE_VALUES_CACHE%DYNAMIC_VARIABLE_TYPE=dynamic_variable_type
2064  ELSE
2065  local_error="The specified dynamic variable type of "// &
2066  & trim(numbertovstring(dynamic_variable_type,"*",err,error))// &
2067  & " is not defined on the dependent field."
2068  CALL flagerror(local_error,err,error,*999)
2069  ENDIF
2070  ELSE
2071  local_error="The specified dynamic variable type of "// &
2072  & trim(numbertovstring(dynamic_variable_type,"*",err,error))// &
2073  & " is invalid. The number must either be zero or >= 1 and <= "// &
2074  & trim(numbertovstring(field_number_of_variable_types,"*",err,error))//"."
2075  CALL flagerror(local_error,err,error,*999)
2076  ENDIF
2077  ELSE
2078  CALL flagerror("Dependent field is not associated",err,error,*999)
2079  ENDIF
2080  ELSE
2081  CALL flagerror("The equations are not dynamic equations.",err,error,*999)
2082  ENDIF
2083  ELSE
2084  CALL flagerror("Equations equations set is not associated.",err,error,*999)
2085  ENDIF
2086  ELSE
2087  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
2088  ENDIF
2089  ENDIF
2090  ELSE
2091  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
2092  ENDIF
2093  ENDIF
2094  ELSE
2095  CALL flagerror("Equations mapping is not associated",err,error,*999)
2096  ENDIF
2097 
2098  exits("EQUATIONS_MAPPING_DYNAMIC_VARIABLE_TYPE_SET")
2099  RETURN
2100 999 errorsexits("EQUATIONS_MAPPING_DYNAMIC_VARIABLE_TYPE_SET",err,error)
2101  RETURN 1
2103 
2104  !
2105  !================================================================================================================================
2106  !
2107 
2109  SUBROUTINE equationsmapping_equatsjacobiantovarmapfinalise(EQUATIONS_JACOBIAN_TO_VAR_MAP,ERR,ERROR,*)
2111  !Argument variables
2112  TYPE(equations_jacobian_to_var_map_type) :: EQUATIONS_JACOBIAN_TO_VAR_MAP
2113  INTEGER(INTG), INTENT(OUT) :: ERR
2114  TYPE(varying_string), INTENT(OUT) :: ERROR
2115  !Local Variables
2116 
2117  enters("EquationsMapping_EquatsJacobianToVarMapFinalise",err,error,*999)
2118 
2119  IF(ALLOCATED(equations_jacobian_to_var_map%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP)) &
2120  & DEALLOCATE(equations_jacobian_to_var_map%EQUATIONS_COLUMN_TO_DOF_VARIABLE_MAP)
2121 
2122  exits("EquationsMapping_EquatsJacobianToVarMapFinalise")
2123  RETURN
2124 999 errors("EquationsMapping_EquatsJacobianToVarMapFinalise",err,error)
2125  exits("EquationsMapping_EquatsJacobianToVarMapFinalise")
2126  RETURN 1
2127 
2129 
2130  !
2131  !================================================================================================================================
2132  !
2133 
2135  SUBROUTINE equationsmapping_equatsjacobiantovarmapinitialise(EQUATIONS_JACOBIAN_TO_VAR_MAP,ERR,ERROR,*)
2137  !Argument variables
2138  TYPE(equations_jacobian_to_var_map_type) :: EQUATIONS_JACOBIAN_TO_VAR_MAP
2139  INTEGER(INTG), INTENT(OUT) :: ERR
2140  TYPE(varying_string), INTENT(OUT) :: ERROR
2141  !Local Variables
2142 
2143  enters("EquationsMapping_EquatsJacobianToVarMapInitialise",err,error,*999)
2144 
2145  equations_jacobian_to_var_map%VARIABLE_TYPE=0
2146  NULLIFY(equations_jacobian_to_var_map%VARIABLE)
2147  NULLIFY(equations_jacobian_to_var_map%JACOBIAN)
2148  equations_jacobian_to_var_map%NUMBER_OF_COLUMNS=0
2149  equations_jacobian_to_var_map%JACOBIAN_COEFFICIENT=0
2150  NULLIFY(equations_jacobian_to_var_map%COLUMN_DOFS_MAPPING)
2151 
2152  exits("EquationsMapping_EquatsJacobianToVarMapInitialise")
2153  RETURN
2154 999 errors("EquationsMapping_EquatsJacobianToVarMapInitialise",err,error)
2155  exits("EquationsMapping_EquatsJacobianToVarMapInitialise")
2156  RETURN 1
2157 
2159 
2160  !
2161  !================================================================================================================================
2162  !
2163 
2165  SUBROUTINE equationsmapping_equationsmatrixtovarmapfinalise(EQUATIONS_MATRIX_TO_VAR_MAP,ERR,ERROR,*)
2167  !Argument variables
2168  TYPE(equations_matrix_to_var_map_type) :: EQUATIONS_MATRIX_TO_VAR_MAP
2169  INTEGER(INTG), INTENT(OUT) :: ERR
2170  TYPE(varying_string), INTENT(OUT) :: ERROR
2171  !Local Variables
2172 
2173  enters("EquationsMapping_EquationsMatrixToVarMapFinalise",err,error,*999)
2174 
2175  IF(ALLOCATED(equations_matrix_to_var_map%COLUMN_TO_DOF_MAP)) &
2176  & DEALLOCATE(equations_matrix_to_var_map%COLUMN_TO_DOF_MAP)
2177 
2178  exits("EquationsMapping_EquationsMatrixToVarMapFinalise")
2179  RETURN
2180 999 errors("EquationsMapping_EquationsMatrixToVarMapFinalise",err,error)
2181  exits("EquationsMapping_EquationsMatrixToVarMapFinalise")
2182  RETURN 1
2183 
2185 
2186  !
2187  !================================================================================================================================
2188  !
2189 
2191  SUBROUTINE equationsmapping_equatsmatrixtovarmapinitialise(EQUATIONS_MATRIX_TO_VAR_MAP,ERR,ERROR,*)
2193  !Argument variables
2194  TYPE(equations_matrix_to_var_map_type) :: EQUATIONS_MATRIX_TO_VAR_MAP
2195  INTEGER(INTG), INTENT(OUT) :: ERR
2196  TYPE(varying_string), INTENT(OUT) :: ERROR
2197  !Local Variables
2198 
2199  enters("EquationsMapping_EquatsMatrixToVarMapInitialise",err,error,*999)
2200 
2201  equations_matrix_to_var_map%MATRIX_NUMBER=0
2202  equations_matrix_to_var_map%VARIABLE_TYPE=0
2203  NULLIFY(equations_matrix_to_var_map%VARIABLE)
2204  equations_matrix_to_var_map%NUMBER_OF_COLUMNS=0
2205  equations_matrix_to_var_map%MATRIX_COEFFICIENT=1.0_dp !Matrices in an equation set are added by default
2206  NULLIFY(equations_matrix_to_var_map%COLUMN_DOFS_MAPPING)
2207 
2208  exits("EquationsMapping_EquatsMatrixToVarMapInitialise")
2209  RETURN
2210 999 errors("EquationsMapping_EquatsMatrixToVarMapInitialise",err,error)
2211  exits("EquationsMapping_EquatsMatrixToVarMapInitialise")
2212  RETURN 1
2213 
2215 
2216  !
2217  !================================================================================================================================
2218  !
2219 
2221  SUBROUTINE equations_mapping_finalise(EQUATIONS_MAPPING,ERR,ERROR,*)
2223  !Argument variables
2224  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2225  INTEGER(INTG), INTENT(OUT) :: ERR
2226  TYPE(varying_string), INTENT(OUT) :: ERROR
2227  !Local Variables
2228 
2229  enters("EQUATIONS_MAPPING_FINALISE",err,error,*999)
2230 
2231  IF(ASSOCIATED(equations_mapping)) THEN
2232  !Row dofs mappings are linked to the field mapping therefore do not deallocate here
2233  NULLIFY(equations_mapping%ROW_DOFS_MAPPING)
2234  CALL equations_mapping_dynamic_mapping_finalise(equations_mapping%DYNAMIC_MAPPING,err,error,*999)
2235  CALL equations_mapping_linear_mapping_finalise(equations_mapping%LINEAR_MAPPING,err,error,*999)
2236  CALL equationsmapping_nonlinearmappingfinalise(equations_mapping%NONLINEAR_MAPPING,err,error,*999)
2237  CALL equations_mapping_rhs_mapping_finalise(equations_mapping%RHS_MAPPING,err,error,*999)
2238  CALL equations_mapping_source_mapping_finalise(equations_mapping%SOURCE_MAPPING,err,error,*999)
2239  CALL equationsmapping_createvaluescachefinalise(equations_mapping%CREATE_VALUES_CACHE,err,error,*999)
2240  DEALLOCATE(equations_mapping)
2241  ENDIF
2242 
2243  exits("EQUATIONS_MAPPING_FINALISE")
2244  RETURN
2245 999 errorsexits("EQUATIONS_MAPPING_FINALISE",err,error)
2246  RETURN 1
2247 
2248  END SUBROUTINE equations_mapping_finalise
2249 
2250  !
2251  !================================================================================================================================
2252  !
2253 
2255  SUBROUTINE equations_mapping_initialise(EQUATIONS,ERR,ERROR,*)
2257  !Argument variables
2258  TYPE(equations_type), POINTER :: EQUATIONS
2259  INTEGER(INTG), INTENT(OUT) :: ERR
2260  TYPE(varying_string), INTENT(OUT) :: ERROR
2261  !Local Variables
2262  INTEGER(INTG) :: DUMMY_ERR
2263  TYPE(varying_string) :: DUMMY_ERROR
2264 
2265  enters("EQUATIONS_MAPPING_INITIALISE",err,error,*998)
2266 
2267  IF(ASSOCIATED(equations)) THEN
2268  IF(ASSOCIATED(equations%EQUATIONS_MAPPING)) THEN
2269  CALL flagerror("Equations mapping is already associated.",err,error,*998)
2270  ELSE
2271  ALLOCATE(equations%EQUATIONS_MAPPING,stat=err)
2272  IF(err/=0) CALL flagerror("Could not allocate equations equations mapping.",err,error,*999)
2273  equations%EQUATIONS_MAPPING%EQUATIONS=>equations
2274  equations%EQUATIONS_MAPPING%EQUATIONS_MAPPING_FINISHED=.false.
2275  NULLIFY(equations%EQUATIONS_MAPPING%ROW_DOFS_MAPPING)
2276  NULLIFY(equations%EQUATIONS_MAPPING%DYNAMIC_MAPPING)
2277  NULLIFY(equations%EQUATIONS_MAPPING%LINEAR_MAPPING)
2278  NULLIFY(equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING)
2279  NULLIFY(equations%EQUATIONS_MAPPING%RHS_MAPPING)
2280  NULLIFY(equations%EQUATIONS_MAPPING%SOURCE_MAPPING)
2281  NULLIFY(equations%EQUATIONS_MAPPING%CREATE_VALUES_CACHE)
2282  CALL equationsmapping_createvaluescacheinitialise(equations%EQUATIONS_MAPPING,err,error,*999)
2283  ENDIF
2284  ELSE
2285  CALL flagerror("Equations is not associated.",err,error,*998)
2286  ENDIF
2287 
2288  exits("EQUATIONS_MAPPING_INITIALISE")
2289  RETURN
2290 999 CALL equations_mapping_finalise(equations%EQUATIONS_MAPPING,dummy_err,dummy_error,*998)
2291 998 errorsexits("EQUATIONS_MAPPING_INITIALISE",err,error)
2292  RETURN 1
2293 
2294  END SUBROUTINE equations_mapping_initialise
2295 
2296  !
2297  !================================================================================================================================
2298  !
2299 
2301  SUBROUTINE equationsmapping_residualvariablesnumberset(EQUATIONS_MAPPING,NUMBER_OF_VARIABLES,ERR,ERROR,*)
2303  !Argument variables
2304  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2305  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_VARIABLES
2306  INTEGER(INTG), INTENT(OUT) :: ERR
2307  TYPE(varying_string), INTENT(OUT) :: ERROR
2308  !Local Variables
2309  INTEGER(INTG) :: PREVIOUS_NUMBER,MIN_NUMBER
2310  INTEGER(INTG), ALLOCATABLE :: NEW_RESIDUAL_VARIABLE_TYPES(:)
2311  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2312 
2313  enters("EquationsMapping_ResidualVariablesNumberSet",err,error,*999)
2314 
2315  IF(ASSOCIATED(equations_mapping)) THEN
2316  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2317  CALL flagerror("Equations mapping have been finished.",err,error,*999)
2318  ELSE
2319  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2320  IF(ASSOCIATED(create_values_cache)) THEN
2321  previous_number=create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
2322  IF(number_of_variables/=previous_number) THEN
2323  !Create new residual_variable_types array and copy over previous values
2324  min_number=min(number_of_variables,previous_number)
2325  ALLOCATE(new_residual_variable_types(number_of_variables),stat=err)
2326  IF(err/=0) CALL flagerror("Could not allocate new residual variable types.",err,error,*999)
2327  new_residual_variable_types=0
2328  new_residual_variable_types(1:min_number)=create_values_cache%RESIDUAL_VARIABLE_TYPES(1:min_number)
2329  CALL move_alloc(new_residual_variable_types,create_values_cache%RESIDUAL_VARIABLE_TYPES)
2330  !Set number of residual variables
2331  create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES=number_of_variables
2332  ENDIF
2333  ELSE
2334  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
2335  ENDIF
2336  ENDIF
2337  ELSE
2338  CALL flagerror("Equations mapping is not associated",err,error,*999)
2339  ENDIF
2340 
2341  exits("EquationsMapping_ResidualVariablesNumberSet")
2342  RETURN
2343 999 errorsexits("EquationsMapping_ResidualVariablesNumberSet",err,error)
2344  RETURN 1
2345 
2347 
2348  !
2349  !================================================================================================================================
2350  !
2351 
2353  SUBROUTINE equations_mapping_linear_mapping_finalise(LINEAR_MAPPING,ERR,ERROR,*)
2355  !Argument variables
2356  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
2357  INTEGER(INTG), INTENT(OUT) :: ERR
2358  TYPE(varying_string), INTENT(OUT) :: ERROR
2359  !Local Variables
2360  INTEGER(INTG) :: matrix_idx,variable_type
2361 
2362  enters("EQUATIONS_MAPPING_LINEAR_MAPPING_FINALISE",err,error,*999)
2363 
2364  IF(ASSOCIATED(linear_mapping)) THEN
2365  IF(ALLOCATED(linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES)) DEALLOCATE(linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES)
2366  IF(ALLOCATED(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS)) THEN
2367  DO variable_type=1,SIZE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS,1)
2369  & var_to_equations_matrices_maps(variable_type),err,error,*999)
2370  ENDDO !variable_type
2371  DEALLOCATE(linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS)
2372  ENDIF
2373  IF(ALLOCATED(linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS)) THEN
2374  DO matrix_idx=1,SIZE(linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS,1)
2376  & equations_matrix_to_var_maps(matrix_idx),err,error,*999)
2377  ENDDO !matrix_idx
2378  DEALLOCATE(linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS)
2379  ENDIF
2380  IF(ALLOCATED(linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS)) DEALLOCATE(linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS)
2381  DEALLOCATE(linear_mapping)
2382  ENDIF
2383 
2384  exits("EQUATIONS_MAPPING_LINEAR_MAPPING_FINALISE")
2385  RETURN
2386 999 errorsexits("EQUATIONS_MAPPING_LINEAR_MAPPING_INITIALISE",err,error)
2387  RETURN 1
2389 
2390  !
2391  !================================================================================================================================
2392  !
2393 
2395  SUBROUTINE equations_mapping_linear_mapping_initialise(EQUATIONS_MAPPING,ERR,ERROR,*)
2397  !Argument variables
2398  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2399  INTEGER(INTG), INTENT(OUT) :: ERR
2400  TYPE(varying_string), INTENT(OUT) :: ERROR
2401  !Local Variables
2402  INTEGER(INTG) :: DUMMY_ERR
2403  TYPE(varying_string) :: DUMMY_ERROR
2404 
2405  enters("EQUATIONS_MAPPING_LINEAR_MAPPING_INITIALISE",err,error,*998)
2406 
2407  IF(ASSOCIATED(equations_mapping)) THEN
2408  IF(ASSOCIATED(equations_mapping%LINEAR_MAPPING)) THEN
2409  CALL flagerror("Equations mapping linear mapping is already associated.",err,error,*998)
2410  ELSE
2411  ALLOCATE(equations_mapping%LINEAR_MAPPING,stat=err)
2412  IF(err/=0) CALL flagerror("Could not allocate equations mapping linear mapping.",err,error,*999)
2413  equations_mapping%LINEAR_MAPPING%EQUATIONS_MAPPING=>equations_mapping
2414  equations_mapping%LINEAR_MAPPING%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=0
2415  equations_mapping%LINEAR_MAPPING%NUMBER_OF_LINEAR_MATRIX_VARIABLES=0
2416  ENDIF
2417  ELSE
2418  CALL flagerror("Equations is not associated.",err,error,*998)
2419  ENDIF
2420 
2421  exits("EQUATIONS_MAPPING_LINEAR_MAPPING_INITIALISE")
2422  RETURN
2423 999 CALL equations_mapping_linear_mapping_finalise(equations_mapping%LINEAR_MAPPING,dummy_err,dummy_error,*998)
2424 998 errorsexits("EQUATIONS_MAPPING_LINEAR_MAPPING_INITIALISE",err,error)
2425  RETURN 1
2427 
2428  !
2429  !================================================================================================================================
2430  !
2431 
2433  SUBROUTINE equationsmapping_linearmatricescoeffsset(EQUATIONS_MAPPING,LINEAR_MATRIX_COEFFICIENTS,ERR,ERROR,*)
2435  !Argument variables
2436  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2437  REAL(DP), INTENT(IN) :: LINEAR_MATRIX_COEFFICIENTS(:)
2438  INTEGER(INTG), INTENT(OUT) :: ERR
2439  TYPE(varying_string), INTENT(OUT) :: ERROR
2440  !Local Variables
2441  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2442  TYPE(varying_string) :: LOCAL_ERROR
2443 
2444  enters("EquationsMapping_LinearMatricesCoeffsSet",err,error,*999)
2445 
2446  IF(ASSOCIATED(equations_mapping)) THEN
2447  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2448  CALL flagerror("Equations mapping is finished.",err,error,*999)
2449  ELSE
2450  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2451  IF(ASSOCIATED(create_values_cache)) THEN
2452  IF(SIZE(linear_matrix_coefficients,1)==create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES) THEN
2453  create_values_cache%LINEAR_MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)= &
2454  & linear_matrix_coefficients(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)
2455  ELSE
2456  local_error="Invalid size of linear matrix coefficeints. The size of the supplied array ("// &
2457  & trim(numbertovstring(SIZE(linear_matrix_coefficients,1),"*",err,error))// &
2458  & ") must match the number of linear equations matrices ("// &
2459  & trim(numbertovstring(equations_mapping%CREATE_VALUES_CACHE% &
2460  & number_of_linear_equations_matrices,"*",err,error))//")."
2461  CALL flagerror(local_error,err,error,*999)
2462  ENDIF
2463  ELSE
2464  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
2465  ENDIF
2466  ENDIF
2467  ELSE
2468  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2469  ENDIF
2470 
2471  exits("EquationsMapping_LinearMatricesCoeffsSet")
2472  RETURN
2473 999 errorsexits("EquationsMapping_LinearMatricesCoeffsSet",err,error)
2474  RETURN 1
2475 
2477 
2478  !
2479  !================================================================================================================================
2480  !
2481 
2483  SUBROUTINE equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING,NUMBER_OF_LINEAR_EQUATIONS_MATRICES,ERR,ERROR,*)
2485  !Argument variables
2486  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2487  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2488  INTEGER(INTG), INTENT(OUT) :: ERR
2489  TYPE(varying_string), INTENT(OUT) :: ERROR
2490  !Local Variables
2491  INTEGER(INTG) :: matrix_idx
2492  INTEGER(INTG), ALLOCATABLE :: OLD_LINEAR_MATRIX_VARIABLE_TYPES(:)
2493  REAL(DP), ALLOCATABLE :: OLD_LINEAR_MATRIX_COEFFICIENTS(:)
2494  TYPE(equations_type), POINTER :: EQUATIONS
2495  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2496  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2497  TYPE(field_type), POINTER :: DEPENDENT_FIELD
2498  TYPE(varying_string) :: LOCAL_ERROR
2499 
2500  enters("EquationsMapping_LinearMatricesNumberSet",err,error,*999)
2501 
2502  IF(ASSOCIATED(equations_mapping)) THEN
2503  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2504  CALL flagerror("Equations mapping has been finished",err,error,*999)
2505  ELSE
2506  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2507  IF(ASSOCIATED(create_values_cache)) THEN
2508  equations=>equations_mapping%EQUATIONS
2509  IF(ASSOCIATED(equations)) THEN
2510  equations_set=>equations%EQUATIONS_SET
2511  IF(ASSOCIATED(equations_set)) THEN
2512  !Check number of matrices to create is valid
2513  SELECT CASE(equations%TIME_DEPENDENCE)
2515  SELECT CASE(equations%LINEARITY)
2517  IF(create_values_cache%RHS_VARIABLE_TYPE==0) THEN
2518  IF(number_of_linear_equations_matrices<1) THEN
2519  local_error="The specified number of linear matrices of "// &
2520  & trim(numbertovstring(number_of_linear_equations_matrices,"*",err,error))// &
2521  & " is invalid. For non-dynamic linear problems without a equations set RHS the number must be "// &
2522  & ">= 1."
2523  CALL flagerror(local_error,err,error,*999)
2524  ENDIF
2525  ELSE
2526  IF(number_of_linear_equations_matrices<1) THEN
2527  local_error="The specified number of linear matrices of "// &
2528  & trim(numbertovstring(number_of_linear_equations_matrices,"*",err,error))// &
2529  & " is invalid. For non-dynamic linear problems with a equations set RHS the number "// &
2530  & "must be >= 1."
2531  CALL flagerror(local_error,err,error,*999)
2532  ENDIF
2533  ENDIF
2534  CASE(equations_nonlinear)
2535  IF(number_of_linear_equations_matrices<0.OR. &
2536  & number_of_linear_equations_matrices>field_number_of_variable_types-2) THEN
2537  local_error="The specified number of linear matrices of "// &
2538  & trim(numbertovstring(number_of_linear_equations_matrices,"*",err,error))// &
2539  & ") is invalid. For non-dynamic non-linear problems the number must be between >= 0 and <= "// &
2540  & trim(numbertovstring(field_number_of_variable_types-2,"*",err,error))
2541  CALL flagerror(local_error,err,error,*999)
2542  ENDIF
2543  CASE DEFAULT
2544  local_error="The equations linearity type of "// &
2545  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
2546  CALL flagerror(local_error,err,error,*999)
2547  END SELECT
2549  SELECT CASE(equations%LINEARITY)
2551  IF(create_values_cache%RHS_VARIABLE_TYPE==0) THEN
2552  IF(number_of_linear_equations_matrices<1.OR. &
2553  & number_of_linear_equations_matrices>field_number_of_variable_types-1) THEN
2554  local_error="The specified number of linear matrices of "// &
2555  & trim(numbertovstring(number_of_linear_equations_matrices,"*",err,error))// &
2556  & " is invalid. For dynamic linear problems without a equations set RHS the number must be "// &
2557  & "between >= 1 and <= "//trim(numbertovstring(field_number_of_variable_types-1,"*",err,error))
2558  CALL flagerror(local_error,err,error,*999)
2559  ENDIF
2560  ELSE
2561  IF(number_of_linear_equations_matrices<0) THEN
2562  local_error="The specified number of linear matrices of "// &
2563  & trim(numbertovstring(number_of_linear_equations_matrices,"*",err,error))// &
2564  & " is invalid. For dynamic linear problems with a equations set RHS the number "// &
2565  & "must be >= 0."
2566  CALL flagerror(local_error,err,error,*999)
2567  ENDIF
2568  ENDIF
2569  CASE(equations_nonlinear)
2570  CALL flagerror("Not implemented.",err,error,*999)
2571  CASE DEFAULT
2572  local_error="The equations linearity type of "// &
2573  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
2574  CALL flagerror(local_error,err,error,*999)
2575  END SELECT
2576  CASE DEFAULT
2577  local_error="The equations time dependence type of "// &
2578  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
2579  CALL flagerror(local_error,err,error,*999)
2580  END SELECT
2581  !If we need to reallocate and reset all the create_values cache arrays and change the number of matrices
2582  IF(number_of_linear_equations_matrices/=create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES) THEN
2583  IF(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES>0) THEN
2584  ALLOCATE(old_linear_matrix_variable_types(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
2585  IF(err/=0) CALL flagerror("Could not allocate old linear matrix variable types.",err,error,*999)
2586  ALLOCATE(old_linear_matrix_coefficients(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
2587  IF(err/=0) CALL flagerror("Could not allocate old linear matrix coefficients.",err,error,*999)
2588  old_linear_matrix_variable_types(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)= &
2589  & create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)
2590  old_linear_matrix_coefficients(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)= &
2591  & create_values_cache%LINEAR_MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES)
2592  ENDIF
2593  IF(ALLOCATED(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES)) &
2594  & DEALLOCATE(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES)
2595  IF(ALLOCATED(create_values_cache%LINEAR_MATRIX_COEFFICIENTS)) &
2596  & DEALLOCATE(create_values_cache%LINEAR_MATRIX_COEFFICIENTS)
2597  ALLOCATE(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(number_of_linear_equations_matrices),stat=err)
2598  IF(err/=0) CALL flagerror("Could not allocate linear matrix variable types.",err,error,*999)
2599  ALLOCATE(create_values_cache%LINEAR_MATRIX_COEFFICIENTS(number_of_linear_equations_matrices),stat=err)
2600  IF(err/=0) CALL flagerror("Could not allocate linear matrix coefficients.",err,error,*999)
2601  IF(create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES>0) THEN
2602  IF(number_of_linear_equations_matrices>create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES) THEN
2603  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1:create_values_cache% &
2604  & number_of_linear_equations_matrices)=old_linear_matrix_variable_types
2605  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(create_values_cache% &
2606  & number_of_linear_equations_matrices+1:number_of_linear_equations_matrices)= &
2607  & old_linear_matrix_variable_types(1)
2608  create_values_cache%LINEAR_MATRIX_COEFFICIENTS(1:create_values_cache% &
2609  & number_of_linear_equations_matrices)=old_linear_matrix_coefficients
2610  create_values_cache%LINEAR_MATRIX_COEFFICIENTS(create_values_cache% &
2611  & number_of_linear_equations_matrices+1:number_of_linear_equations_matrices)= &
2612  & old_linear_matrix_coefficients(1)
2613  ELSE
2614  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1:number_of_linear_equations_matrices)= &
2615  & old_linear_matrix_variable_types(1:number_of_linear_equations_matrices)
2616  create_values_cache%LINEAR_MATRIX_COEFFICIENTS(1:number_of_linear_equations_matrices)= &
2617  & old_linear_matrix_coefficients(1:number_of_linear_equations_matrices)
2618  ENDIF
2619  ELSE
2620  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2621  IF(ASSOCIATED(dependent_field)) THEN
2622  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES=0
2623  SELECT CASE(equations%TIME_DEPENDENCE)
2625  SELECT CASE(equations%LINEARITY)
2627  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR)) THEN
2628  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1)=dependent_field% &
2629  & variable_type_map(field_u_variable_type)%PTR%VARIABLE_TYPE
2630  ELSE
2631  CALL flagerror("Not implemented.",err,error,*999)
2632  ENDIF
2633  DO matrix_idx=2,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2634  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(matrix_idx+1)%PTR)) THEN
2635  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)= &
2636  & dependent_field%VARIABLE_TYPE_MAP(matrix_idx+1)%PTR%VARIABLE_TYPE
2637  ELSE
2638  CALL flagerror("Not implemented.",err,error,*999)
2639  ENDIF
2640  ENDDO !matrix_idx
2641  CASE(equations_nonlinear)
2642  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2643  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(matrix_idx+2)%PTR)) THEN
2644  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)= &
2645  & dependent_field%VARIABLE_TYPE_MAP(matrix_idx+2)%PTR%VARIABLE_TYPE
2646  ELSE
2647  CALL flagerror("Not implemented.",err,error,*999)
2648  ENDIF
2649  ENDDO !matrix_idx
2650  CASE DEFAULT
2651  local_error="The equations linearity type of "// &
2652  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
2653  CALL flagerror(local_error,err,error,*999)
2654  END SELECT
2656  SELECT CASE(equations%LINEARITY)
2658  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2659  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(matrix_idx+2)%PTR)) THEN
2660  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)= &
2661  & dependent_field%VARIABLE_TYPE_MAP(matrix_idx+2)%PTR%VARIABLE_TYPE
2662  ELSE
2663  CALL flagerror("Not implemented.",err,error,*999)
2664  ENDIF
2665  ENDDO !matrix_idx
2666  CASE(equations_nonlinear)
2667  CALL flagerror("Not implemented.",err,error,*999)
2668  CASE DEFAULT
2669  local_error="The equations linearity type of "// &
2670  & trim(numbertovstring(equations%LINEARITY,"*",err,error))//" is invalid."
2671  CALL flagerror(local_error,err,error,*999)
2672  END SELECT
2673  CASE DEFAULT
2674  local_error="The equations time dependence type of "// &
2675  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
2676  CALL flagerror(local_error,err,error,*999)
2677  END SELECT
2678  create_values_cache%LINEAR_MATRIX_COEFFICIENTS=1.0_dp !Equations matrices are added by default
2679  ELSE
2680  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
2681  ENDIF
2682  ENDIF
2683  create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES=number_of_linear_equations_matrices
2684  IF(ALLOCATED(old_linear_matrix_variable_types)) DEALLOCATE(old_linear_matrix_variable_types)
2685  IF(ALLOCATED(old_linear_matrix_coefficients)) DEALLOCATE(old_linear_matrix_coefficients)
2686  ENDIF
2687  ELSE
2688  CALL flagerror("Equations equations set is not associated",err,error,*999)
2689  ENDIF
2690  ELSE
2691  CALL flagerror("Equations mapping equations is not associated",err,error,*999)
2692  ENDIF
2693  ELSE
2694  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
2695  ENDIF
2696  ENDIF
2697  ELSE
2698  CALL flagerror("Equations mapping is not associated",err,error,*999)
2699  ENDIF
2700 
2701  exits("EquationsMapping_LinearMatricesNumberSet")
2702  RETURN
2703 999 IF(ALLOCATED(old_linear_matrix_variable_types)) DEALLOCATE(old_linear_matrix_variable_types)
2704  IF(ALLOCATED(old_linear_matrix_coefficients)) DEALLOCATE(old_linear_matrix_coefficients)
2705  errorsexits("EquationsMapping_LinearMatricesNumberSet",err,error)
2706  RETURN 1
2707 
2709 
2710  !
2711  !================================================================================================================================
2712  !
2713 
2715  SUBROUTINE equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING,LINEAR_MATRIX_VARIABLE_TYPES,ERR,ERROR,*)
2717  !Argument variables
2718  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2719  INTEGER(INTG), INTENT(IN) :: LINEAR_MATRIX_VARIABLE_TYPES(:)
2720  INTEGER(INTG), INTENT(OUT) :: ERR
2721  TYPE(varying_string), INTENT(OUT) :: ERROR
2722  !Local Variables
2723  INTEGER(INTG) :: matrix_idx
2724  TYPE(equations_type), POINTER :: EQUATIONS
2725  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2726  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2727  TYPE(field_type), POINTER :: DEPENDENT_FIELD
2728  TYPE(varying_string) :: LOCAL_ERROR
2729 
2730  enters("EquationsMapping_LinearMatricesVariableTypesSet",err,error,*999)
2731 
2732  IF(ASSOCIATED(equations_mapping)) THEN
2733  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2734  CALL flagerror("Equations mapping has been finished.",err,error,*999)
2735  ELSE
2736  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2737  IF(ASSOCIATED(create_values_cache)) THEN
2738  IF(SIZE(linear_matrix_variable_types,1)==create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES) THEN
2739  equations=>equations_mapping%EQUATIONS
2740  IF(ASSOCIATED(equations)) THEN
2741  equations_set=>equations%EQUATIONS_SET
2742  IF(ASSOCIATED(equations_set)) THEN
2743  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2744  IF(ASSOCIATED(dependent_field)) THEN
2745  !Check input values
2746  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2747  IF(linear_matrix_variable_types(matrix_idx)/=0) THEN
2748  !Check the residual variable type is not being by other equations matrices or vectors
2749  !Don't check against the residual variable as we can have linear parts of nonlinear equations
2750  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==linear_matrix_variable_types(matrix_idx)) THEN
2751  local_error="The specified linear matrix variable type of "// &
2752  & trim(numbertovstring(linear_matrix_variable_types(matrix_idx),"*",err,error))// &
2753  & " for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2754  & " is the same as the variable type for the dynamic matrices."
2755  CALL flagerror(local_error,err,error,*999)
2756  ENDIF
2757  IF(create_values_cache%RHS_VARIABLE_TYPE==linear_matrix_variable_types(matrix_idx)) THEN
2758  local_error="The specified linear matrix variable type of "// &
2759  & trim(numbertovstring(linear_matrix_variable_types(matrix_idx),"*",err,error))// &
2760  & " for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2761  & " is the same as the variable type for the RHS vector."
2762  CALL flagerror(local_error,err,error,*999)
2763  ENDIF
2764  !Check to see if the linear matrix variable numbers are defined on the dependent field
2765  IF(linear_matrix_variable_types(matrix_idx)>=1.OR. &
2766  & linear_matrix_variable_types(matrix_idx)<=field_number_of_variable_types) THEN
2767  IF(.NOT.ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(linear_matrix_variable_types(matrix_idx))%PTR)) THEN
2768  local_error="The linear matrix variable type of "// &
2769  & trim(numbertovstring(linear_matrix_variable_types(matrix_idx),"*",err,error))// &
2770  & " for linear matrix NUMBER "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2771  & " is not defined on the dependent field."
2772  CALL flagerror(local_error,err,error,*999)
2773  ENDIF
2774  ELSE
2775  local_error="The linear matrix variable type of "// &
2776  & trim(numbertovstring(linear_matrix_variable_types(matrix_idx),"*",err,error))// &
2777  & " for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2778  & " is invalid. The variable types must be either zero or >= 1 and <= "// &
2779  & trim(numbertovstring(field_number_of_variable_types,"*",err,error))//"."
2780  CALL flagerror(local_error,err,error,*999)
2781  ENDIF
2782  ENDIF
2783  ENDDO !matrix_idx
2784  create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(1:SIZE(linear_matrix_variable_types))= &
2785  & linear_matrix_variable_types(1:SIZE(linear_matrix_variable_types))
2786  ELSE
2787  CALL flagerror("Dependent field is not associated.",err,error,*999)
2788  ENDIF
2789  ELSE
2790  CALL flagerror("Equations equations set is not associated.",err,error,*999)
2791  ENDIF
2792  ELSE
2793  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
2794  ENDIF
2795  ELSE
2796  local_error="Invalid size of linear matrix variable types. The size of the supplied array ("// &
2797  & trim(numbertovstring(SIZE(linear_matrix_variable_types,1),"*",err,error))// &
2798  & ") must match the number of linear equations matrices ("// &
2799  & trim(numbertovstring(equations_mapping%CREATE_VALUES_CACHE% &
2800  & number_of_linear_equations_matrices,"*",err,error))//")."
2801  CALL flagerror(local_error,err,error,*999)
2802  ENDIF
2803  ELSE
2804  CALL flagerror("Equations mapping create values cache is not associated.",err,error,*999)
2805  ENDIF
2806  ENDIF
2807  ELSE
2808  CALL flagerror("Equations mapping is not associated.",err,error,*999)
2809  ENDIF
2810 
2811  exits("EquationsMapping_LinearMatricesVariableTypesSet")
2812  RETURN
2813 999 errors("EquationsMapping_LinearMatricesVariableTypesSet",err,error)
2814  exits("EquationsMapping_LinearMatricesVariableTypesSet")
2815  RETURN 1
2816 
2818 
2819  !
2820  !================================================================================================================================
2821  !
2822 
2824  SUBROUTINE equationsmapping_nonlinearmappingfinalise(NONLINEAR_MAPPING,ERR,ERROR,*)
2826  !Argument variables
2827  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
2828  INTEGER(INTG), INTENT(OUT) :: ERR
2829  TYPE(varying_string), INTENT(OUT) :: ERROR
2830  !Local Variables
2831  INTEGER(INTG) matrix_idx
2832 
2833  enters("EquationsMapping_NonlinearMappingFinalise",err,error,*999)
2834 
2835  IF(ASSOCIATED(nonlinear_mapping)) THEN
2836  DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
2837  CALL equationsmapping_vartoequatsjacobianmapfinalise(nonlinear_mapping%VAR_TO_JACOBIAN_MAP(matrix_idx),err,error,*999)
2838  CALL equationsmapping_equatsjacobiantovarmapfinalise(nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx),err,error,*999)
2839  ENDDO
2840  IF(ALLOCATED(nonlinear_mapping%EQUATIONS_ROW_TO_RESIDUAL_DOF_MAP)) &
2841  & DEALLOCATE(nonlinear_mapping%EQUATIONS_ROW_TO_RESIDUAL_DOF_MAP)
2842  IF(ALLOCATED(nonlinear_mapping%RESIDUAL_VARIABLES)) &
2843  & DEALLOCATE(nonlinear_mapping%RESIDUAL_VARIABLES)
2844  IF(ALLOCATED(nonlinear_mapping%VAR_TO_JACOBIAN_MAP)) &
2845  & DEALLOCATE(nonlinear_mapping%VAR_TO_JACOBIAN_MAP)
2846  IF(ALLOCATED(nonlinear_mapping%JACOBIAN_TO_VAR_MAP)) &
2847  & DEALLOCATE(nonlinear_mapping%JACOBIAN_TO_VAR_MAP)
2848  DEALLOCATE(nonlinear_mapping)
2849  ENDIF
2850 
2851  exits("EquationsMapping_NonlinearMappingFinalise")
2852  RETURN
2853 999 errorsexits("EquationsMapping_NonlinearMappingFinalise",err,error)
2854  RETURN 1
2855 
2857 
2858  !
2859  !================================================================================================================================
2860  !
2861 
2863  SUBROUTINE equationsmapping_nonlinearmappinginitialise(EQUATIONS_MAPPING,ERR,ERROR,*)
2865  !Argument variables
2866  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2867  INTEGER(INTG), INTENT(OUT) :: ERR
2868  TYPE(varying_string), INTENT(OUT) :: ERROR
2869  !Local Variables
2870  INTEGER(INTG) :: DUMMY_ERR
2871  TYPE(varying_string) :: DUMMY_ERROR
2872 
2873  enters("EquationsMapping_NonlinearMappingInitialise",err,error,*998)
2874 
2875  IF(ASSOCIATED(equations_mapping)) THEN
2876  IF(ASSOCIATED(equations_mapping%NONLINEAR_MAPPING)) THEN
2877  CALL flagerror("Equations mapping nonlinear mapping is already associated.",err,error,*998)
2878  ELSE
2879  ALLOCATE(equations_mapping%NONLINEAR_MAPPING,stat=err)
2880  IF(err/=0) CALL flagerror("Could not allocate equations mapping nonlinear mapping.",err,error,*999)
2881  equations_mapping%NONLINEAR_MAPPING%EQUATIONS_MAPPING=>equations_mapping
2882  equations_mapping%NONLINEAR_MAPPING%NUMBER_OF_RESIDUAL_VARIABLES=0
2883  equations_mapping%NONLINEAR_MAPPING%RESIDUAL_COEFFICIENT=1.0_dp
2884  ENDIF
2885  ELSE
2886  CALL flagerror("Equations is not associated.",err,error,*998)
2887  ENDIF
2888 
2889  exits("EquationsMapping_NonlinearMappingInitialise")
2890  RETURN
2891 999 CALL equationsmapping_nonlinearmappingfinalise(equations_mapping%NONLINEAR_MAPPING,dummy_err,dummy_error,*998)
2892 998 errorsexits("EquationsMapping_NonlinearMappingInitialise",err,error)
2893  RETURN 1
2894 
2896 
2897  !
2898  !================================================================================================================================
2899  !
2900 
2902  SUBROUTINE equations_mapping_residual_coeff_set(EQUATIONS_MAPPING,RESIDUAL_COEFFICIENT,ERR,ERROR,*)
2904  !Argument variables
2905  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2906  REAL(DP), INTENT(IN) :: RESIDUAL_COEFFICIENT
2907  INTEGER(INTG), INTENT(OUT) :: ERR
2908  TYPE(varying_string), INTENT(OUT) :: ERROR
2909  !Local Variables
2910 
2911  enters("EQUATIONS_MAPPING_RESIDUAL_COEFF_SET",err,error,*999)
2912 
2913  IF(ASSOCIATED(equations_mapping)) THEN
2914  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2915  CALL flagerror("Equations mapping have been finished.",err,error,*999)
2916  ELSE
2917  IF(ASSOCIATED(equations_mapping%CREATE_VALUES_CACHE)) THEN
2918  equations_mapping%CREATE_VALUES_CACHE%RESIDUAL_COEFFICIENT=residual_coefficient
2919  ELSE
2920  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
2921  ENDIF
2922  ENDIF
2923  ELSE
2924  CALL flagerror("Equations mapping is not associated",err,error,*999)
2925  ENDIF
2926 
2927  exits("EQUATIONS_MAPPING_RESIDUAL_COEFF_SET")
2928  RETURN
2929 999 errorsexits("EQUATIONS_MAPPING_RESIDUAL_COEFF_SET",err,error)
2930  RETURN 1
2932 
2933  !
2934  !================================================================================================================================
2935  !
2936 
2938  SUBROUTINE equationsmapping_residualvariabletypesset(EQUATIONS_MAPPING,RESIDUAL_VARIABLE_TYPES,ERR,ERROR,*)
2940  !Argument variables
2941  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2942  INTEGER(INTG), INTENT(IN) :: RESIDUAL_VARIABLE_TYPES(:)
2943  INTEGER(INTG), INTENT(OUT) :: ERR
2944  TYPE(varying_string), INTENT(OUT) :: ERROR
2945  !Local Variables
2946  INTEGER(INTG) :: matrix_idx,variable_idx,NUMBER_OF_RESIDUAL_VARIABLES,RESIDUAL_VARIABLE_TYPE
2947  TYPE(equations_type), POINTER :: EQUATIONS
2948  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
2949  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2950  TYPE(field_type), POINTER :: DEPENDENT_FIELD
2951  TYPE(varying_string) :: LOCAL_ERROR
2952 
2953  enters("EquationsMapping_ResidualVariableTypesSet",err,error,*999)
2954 
2955  IF(ASSOCIATED(equations_mapping)) THEN
2956  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
2957  CALL flagerror("Equations mapping have been finished.",err,error,*999)
2958  ELSE
2959  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
2960  IF(ASSOCIATED(create_values_cache)) THEN
2961  number_of_residual_variables=SIZE(residual_variable_types,1)
2962  IF(number_of_residual_variables==create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES) THEN
2963  equations=>equations_mapping%EQUATIONS
2964  IF(ASSOCIATED(equations)) THEN
2965  equations_set=>equations%EQUATIONS_SET
2966  IF(ASSOCIATED(equations_set)) THEN
2967  IF(equations%LINEARITY==equations_nonlinear) THEN
2968  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2969  IF(ASSOCIATED(dependent_field)) THEN
2970  !Check the residual variable types are not being used by other equations matrices or vectors
2971  DO variable_idx=1,number_of_residual_variables
2972  residual_variable_type=residual_variable_types(variable_idx)
2973  IF(equations%TIME_DEPENDENCE==equations_static .OR. equations%TIME_DEPENDENCE==equations_quasistatic) THEN
2974  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==residual_variable_type) THEN
2975  local_error="The specified residual variable type of "// &
2976  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
2977  & " is the same as the variable type for the dynamic matrices."
2978  CALL flagerror(local_error,err,error,*999)
2979  ENDIF
2980  ELSE IF(equations%TIME_DEPENDENCE==equations_first_order_dynamic.OR. &
2981  & equations%TIME_DEPENDENCE==equations_second_order_dynamic) THEN
2982  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE/=residual_variable_type) THEN
2983  local_error="The specified residual variable type of "// &
2984  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
2985  & " is not the same as the variable type for the dynamic matrices."
2986  CALL flagerror(local_error,err,error,*999)
2987  ENDIF
2988  ELSE
2989  CALL flagerror("The equations set time dependence is not set.",err,error,*999)
2990  END IF
2991  IF(create_values_cache%RHS_VARIABLE_TYPE==residual_variable_type) THEN
2992  local_error="The specified residual variable type of "// &
2993  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
2994  & " is the same as the variable type for the RHS vector."
2995  CALL flagerror(local_error,err,error,*999)
2996  ENDIF
2997  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
2998  IF(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==residual_variable_type) THEN
2999  local_error="The specified residual variable type of "// &
3000  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
3001  & " is the same as the variable type for linear matrix number "// &
3002  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
3003  CALL flagerror(local_error,err,error,*999)
3004  ENDIF
3005  ENDDO !matrix_idx
3006  !Check the residual variable number is defined on the dependent field
3007  IF(residual_variable_type>=1.AND.residual_variable_type<=field_number_of_variable_types) THEN
3008  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(residual_variable_type)%PTR)) THEN
3009  create_values_cache%RESIDUAL_VARIABLE_TYPES(variable_idx)=residual_variable_type
3010  ELSE
3011  local_error="The specified residual variable type of "// &
3012  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
3013  & " is not defined on the dependent field."
3014  CALL flagerror(local_error,err,error,*999)
3015  ENDIF
3016  ELSE
3017  local_error="The specified residual variable type of "// &
3018  & trim(numbertovstring(residual_variable_type,"*",err,error))// &
3019  & " is invalid. The variable type must either be zero or >= 1 and <= "// &
3020  & trim(numbertovstring(field_number_of_variable_types,"*",err,error))//"."
3021  CALL flagerror(local_error,err,error,*999)
3022  ENDIF
3023  ENDDO !variable_idx
3024  ELSE
3025  CALL flagerror("Dependent field is not associated",err,error,*999)
3026  ENDIF
3027  ELSE
3028  CALL flagerror("The equations set is not a nonlinear equations set.",err,error,*999)
3029  ENDIF
3030  ELSE
3031  CALL flagerror("Equations equations set is not associated.",err,error,*999)
3032  ENDIF
3033  ELSE
3034  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
3035  ENDIF
3036  ELSE
3037  local_error="Invalid number of variables. The number of residual variables " &
3038  & //trim(numbertovstring(number_of_residual_variables,"*",err,error)) &
3039  & //" should be "//trim(numbertovstring(create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES,"*",err,error))
3040  CALL flagerror(local_error,err,error,*999)
3041  ENDIF
3042  ELSE
3043  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
3044  ENDIF
3045  ENDIF
3046  ELSE
3047  CALL flagerror("Equations mapping is not associated",err,error,*999)
3048  ENDIF
3049 
3050  exits("EquationsMapping_ResidualVariableTypesSet")
3051  RETURN
3052 999 errorsexits("EquationsMapping_ResidualVariableTypesSet",err,error)
3053  RETURN 1
3054 
3056 
3057  !
3058  !================================================================================================================================
3059  !
3060 
3062  SUBROUTINE equations_mapping_rhs_coeff_set(EQUATIONS_MAPPING,RHS_COEFFICIENT,ERR,ERROR,*)
3064  !Argument variables
3065  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3066  REAL(DP), INTENT(IN) :: RHS_COEFFICIENT
3067  INTEGER(INTG), INTENT(OUT) :: ERR
3068  TYPE(varying_string), INTENT(OUT) :: ERROR
3069  !Local Variables
3070 
3071  enters("EQUATIONS_MAPPING_RHS_COEFF_SET",err,error,*999)
3072 
3073  IF(ASSOCIATED(equations_mapping)) THEN
3074  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
3075  CALL flagerror("Equations mapping has been finished.",err,error,*999)
3076  ELSE
3077  IF(ASSOCIATED(equations_mapping%CREATE_VALUES_CACHE)) THEN
3078  IF(equations_mapping%CREATE_VALUES_CACHE%RHS_VARIABLE_TYPE/=0) THEN
3079  equations_mapping%CREATE_VALUES_CACHE%RHS_COEFFICIENT=rhs_coefficient
3080  ELSE
3081  CALL flagerror("The equations mapping RHS variable type has not been set.",err,error,*999)
3082  ENDIF
3083  ELSE
3084  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
3085  ENDIF
3086  ENDIF
3087  ELSE
3088  CALL flagerror("Equations mapping is not associated",err,error,*999)
3089  ENDIF
3090 
3091  exits("EQUATIONS_MAPPING_RHS_COEFF_SET")
3092  RETURN
3093 999 errorsexits("EQUATIONS_MAPPING_RHS_COEFF_SET",err,error)
3094  RETURN 1
3095  END SUBROUTINE equations_mapping_rhs_coeff_set
3096 
3097  !
3098  !================================================================================================================================
3099  !
3100 
3102  SUBROUTINE equations_mapping_rhs_mapping_finalise(RHS_MAPPING,ERR,ERROR,*)
3104  !Argument variables
3105  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
3106  INTEGER(INTG), INTENT(OUT) :: ERR
3107  TYPE(varying_string), INTENT(OUT) :: ERROR
3108  !Local Variables
3109 
3110  enters("EQUATIONS_MAPPING_RHS_MAPPING_FINALISE",err,error,*999)
3111 
3112  IF(ASSOCIATED(rhs_mapping)) THEN
3113  IF(ALLOCATED(rhs_mapping%RHS_DOF_TO_EQUATIONS_ROW_MAP)) DEALLOCATE(rhs_mapping%RHS_DOF_TO_EQUATIONS_ROW_MAP)
3114  IF(ALLOCATED(rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP)) DEALLOCATE(rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP)
3115  DEALLOCATE(rhs_mapping)
3116  ENDIF
3117 
3118  exits("EQUATIONS_MAPPING_RHS_MAPPING_FINALISE")
3119  RETURN
3120 999 errorsexits("EQUATIONS_MAPPING_RHS_MAPPING_INITIALISE",err,error)
3121  RETURN 1
3123 
3124  !
3125  !================================================================================================================================
3126  !
3127 
3129  SUBROUTINE equations_mapping_rhs_mapping_initialise(EQUATIONS_MAPPING,ERR,ERROR,*)
3131  !Argument variables
3132  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3133  INTEGER(INTG), INTENT(OUT) :: ERR
3134  TYPE(varying_string), INTENT(OUT) :: ERROR
3135  !Local Variables
3136  INTEGER(INTG) :: DUMMY_ERR
3137  TYPE(varying_string) :: DUMMY_ERROR
3138 
3139  enters("EQUATIONS_MAPPING_RHS_MAPPING_INITIALISE",err,error,*998)
3140 
3141  IF(ASSOCIATED(equations_mapping)) THEN
3142  IF(ASSOCIATED(equations_mapping%RHS_MAPPING)) THEN
3143  CALL flagerror("Equations mapping RHS mapping is already associated.",err,error,*998)
3144  ELSE
3145  ALLOCATE(equations_mapping%RHS_MAPPING,stat=err)
3146  IF(err/=0) CALL flagerror("Could not allocate equations mapping RHS mapping.",err,error,*999)
3147  equations_mapping%RHS_MAPPING%EQUATIONS_MAPPING=>equations_mapping
3148  equations_mapping%RHS_MAPPING%RHS_VARIABLE_TYPE=0
3149  NULLIFY(equations_mapping%RHS_MAPPING%RHS_VARIABLE)
3150  NULLIFY(equations_mapping%RHS_MAPPING%RHS_VARIABLE_MAPPING)
3151  equations_mapping%RHS_MAPPING%RHS_COEFFICIENT=1.0_dp
3152  ENDIF
3153  ELSE
3154  CALL flagerror("Equations mapping is not associated.",err,error,*998)
3155  ENDIF
3156 
3157  exits("EQUATIONS_MAPPING_RHS_MAPPING_INITIALISE")
3158  RETURN
3159 999 CALL equations_mapping_rhs_mapping_finalise(equations_mapping%RHS_MAPPING,dummy_err,dummy_error,*998)
3160 998 errorsexits("EQUATIONS_MAPPING_RHS_MAPPING_INITIALISE",err,error)
3161  RETURN 1
3163 
3164  !
3165  !================================================================================================================================
3166  !
3167 
3169  SUBROUTINE equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING,RHS_VARIABLE_TYPE,ERR,ERROR,*)
3171  !Argument variables
3172  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3173  INTEGER(INTG), INTENT(IN) :: RHS_VARIABLE_TYPE
3174  INTEGER(INTG), INTENT(OUT) :: ERR
3175  TYPE(varying_string), INTENT(OUT) :: ERROR
3176  !Local Variables
3177  INTEGER(INTG) :: matrix_idx
3178  TYPE(equations_type), POINTER :: EQUATIONS
3179  TYPE(equations_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
3180  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3181  TYPE(field_type), POINTER :: DEPENDENT_FIELD
3182  TYPE(varying_string) :: LOCAL_ERROR
3183 
3184  enters("EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET",err,error,*999)
3185 
3186  IF(ASSOCIATED(equations_mapping)) THEN
3187  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
3188  CALL flagerror("Equations mapping has been finished.",err,error,*999)
3189  ELSE
3190  create_values_cache=>equations_mapping%CREATE_VALUES_CACHE
3191  IF(ASSOCIATED(create_values_cache)) THEN
3192  IF(rhs_variable_type==0) THEN
3193  create_values_cache%RHS_VARIABLE_TYPE=0
3194  ELSE
3195  equations=>equations_mapping%EQUATIONS
3196  IF(ASSOCIATED(equations)) THEN
3197  equations_set=>equations%EQUATIONS_SET
3198  IF(ASSOCIATED(equations_set)) THEN
3199  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
3200  IF(ASSOCIATED(dependent_field)) THEN
3201  !Check the RHS variable type is not being by other equations matrices or vectors
3202  IF(create_values_cache%DYNAMIC_VARIABLE_TYPE==rhs_variable_type) THEN
3203  local_error="The specified RHS variable type of "// &
3204  & trim(numbertovstring(rhs_variable_type,"*",err,error))// &
3205  & " is the same as the variable type for the dynamic matrices."
3206  CALL flagerror(local_error,err,error,*999)
3207  ENDIF
3208  DO matrix_idx=1,create_values_cache%NUMBER_OF_RESIDUAL_VARIABLES
3209  IF(create_values_cache%RESIDUAL_VARIABLE_TYPES(matrix_idx)==rhs_variable_type) THEN
3210  local_error="The specified RHS variable type of "// &
3211  & trim(numbertovstring(rhs_variable_type,"*",err,error))// &
3212  & " is the same as the variable type for the residual vector."
3213  CALL flagerror(local_error,err,error,*999)
3214  ENDIF
3215  ENDDO
3216  DO matrix_idx=1,create_values_cache%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
3217  IF(create_values_cache%LINEAR_MATRIX_VARIABLE_TYPES(matrix_idx)==rhs_variable_type) THEN
3218  local_error="The specified RHS variable type of "// &
3219  & trim(numbertovstring(rhs_variable_type,"*",err,error))// &
3220  & " is the same as the variable type for linear matrix number "// &
3221  & trim(numbertovstring(matrix_idx,"*",err,error))//"."
3222  CALL flagerror(local_error,err,error,*999)
3223  ENDIF
3224  ENDDO !matrix_idx
3225  !Check the RHS variable number is defined on the dependent field
3226  IF(rhs_variable_type>=1.AND.rhs_variable_type<=field_number_of_variable_types) THEN
3227  IF(ASSOCIATED(dependent_field%VARIABLE_TYPE_MAP(rhs_variable_type)%PTR)) THEN
3228  create_values_cache%RHS_VARIABLE_TYPE=rhs_variable_type
3229  ELSE
3230  local_error="The specified RHS variable type of "// &
3231  & trim(numbertovstring(rhs_variable_type,"*",err,error))// &
3232  & " is not defined on the dependent field."
3233  CALL flagerror(local_error,err,error,*999)
3234  ENDIF
3235  ELSE
3236  local_error="The specified RHS variable type of "//trim(numbertovstring(rhs_variable_type,"*",err,error))// &
3237  & " is invalid. The number must either be zero or >= 1 and <= "// &
3238  & trim(numbertovstring(field_number_of_variable_types,"*",err,error))//"."
3239  CALL flagerror(local_error,err,error,*999)
3240  ENDIF
3241  ELSE
3242  CALL flagerror("Dependent field is not associated",err,error,*999)
3243  ENDIF
3244  ELSE
3245  CALL flagerror("Equations equations set is not associated.",err,error,*999)
3246  ENDIF
3247  ELSE
3248  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
3249  ENDIF
3250  ENDIF
3251  ELSE
3252  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
3253  ENDIF
3254  ENDIF
3255  ELSE
3256  CALL flagerror("Equations mapping is not associated",err,error,*999)
3257  ENDIF
3258 
3259  exits("EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET")
3260  RETURN
3261 999 errorsexits("EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET",err,error)
3262  RETURN 1
3264 
3265  !
3266  !================================================================================================================================
3267  !
3268 
3270  SUBROUTINE equations_mapping_source_coeff_set(EQUATIONS_MAPPING,SOURCE_COEFFICIENT,ERR,ERROR,*)
3272  !Argument variables
3273  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3274  REAL(DP), INTENT(IN) :: SOURCE_COEFFICIENT
3275  INTEGER(INTG), INTENT(OUT) :: ERR
3276  TYPE(varying_string), INTENT(OUT) :: ERROR
3277  !Local Variables
3278 
3279  enters("EQUATIONS_MAPPING_SOURCE_COEFF_SET",err,error,*999)
3280 
3281  IF(ASSOCIATED(equations_mapping)) THEN
3282  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
3283  CALL flagerror("Equations mapping has been finished.",err,error,*999)
3284  ELSE
3285  IF(ASSOCIATED(equations_mapping%CREATE_VALUES_CACHE)) THEN
3286  IF(equations_mapping%CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE/=0) THEN
3287  equations_mapping%CREATE_VALUES_CACHE%SOURCE_COEFFICIENT=source_coefficient
3288  ELSE
3289  CALL flagerror("The equations mapping source variable type has not been set.",err,error,*999)
3290  ENDIF
3291  ELSE
3292  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
3293  ENDIF
3294  ENDIF
3295  ELSE
3296  CALL flagerror("Equations mapping is not associated",err,error,*999)
3297  ENDIF
3298 
3299  exits("EQUATIONS_MAPPING_SOURCE_COEFF_SET")
3300  RETURN
3301 999 errorsexits("EQUATIONS_MAPPING_SOURCE_COEFF_SET",err,error)
3302  RETURN 1
3303  END SUBROUTINE equations_mapping_source_coeff_set
3304 
3305  !
3306  !================================================================================================================================
3307  !
3308 
3310  SUBROUTINE equations_mapping_source_mapping_finalise(SOURCE_MAPPING,ERR,ERROR,*)
3312  !Argument variables
3313  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
3314  INTEGER(INTG), INTENT(OUT) :: ERR
3315  TYPE(varying_string), INTENT(OUT) :: ERROR
3316  !Local Variables
3317 
3318  enters("EQUATIONS_MAPPING_SOURCE_MAPPING_FINALISE",err,error,*999)
3319 
3320  IF(ASSOCIATED(source_mapping)) THEN
3321  IF(ALLOCATED(source_mapping%SOURCE_DOF_TO_EQUATIONS_ROW_MAP)) DEALLOCATE(source_mapping%SOURCE_DOF_TO_EQUATIONS_ROW_MAP)
3322  IF(ALLOCATED(source_mapping%EQUATIONS_ROW_TO_SOURCE_DOF_MAP)) DEALLOCATE(source_mapping%EQUATIONS_ROW_TO_SOURCE_DOF_MAP)
3323  DEALLOCATE(source_mapping)
3324  ENDIF
3325 
3326  exits("EQUATIONS_MAPPING_SOURCE_MAPPING_FINALISE")
3327  RETURN
3328 999 errorsexits("EQUATIONS_MAPPING_SOURCE_MAPPING_INITIALISE",err,error)
3329  RETURN 1
3331 
3332  !
3333  !================================================================================================================================
3334  !
3335 
3337  SUBROUTINE equations_mapping_source_mapping_initialise(EQUATIONS_MAPPING,ERR,ERROR,*)
3339  !Argument variables
3340  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3341  INTEGER(INTG), INTENT(OUT) :: ERR
3342  TYPE(varying_string), INTENT(OUT) :: ERROR
3343  !Local Variables
3344  INTEGER(INTG) :: DUMMY_ERR
3345  TYPE(varying_string) :: DUMMY_ERROR
3346 
3347  enters("EQUATIONS_MAPPING_SOURCE_MAPPING_INITIALISE",err,error,*998)
3348 
3349  IF(ASSOCIATED(equations_mapping)) THEN
3350  IF(ASSOCIATED(equations_mapping%SOURCE_MAPPING)) THEN
3351  CALL flagerror("Equations mapping source mapping is already associated.",err,error,*998)
3352  ELSE
3353  ALLOCATE(equations_mapping%SOURCE_MAPPING,stat=err)
3354  IF(err/=0) CALL flagerror("Could not allocate equations mapping source mapping.",err,error,*999)
3355  equations_mapping%SOURCE_MAPPING%EQUATIONS_MAPPING=>equations_mapping
3356  equations_mapping%SOURCE_MAPPING%SOURCE_VARIABLE_TYPE=0
3357  NULLIFY(equations_mapping%SOURCE_MAPPING%SOURCE_VARIABLE)
3358  NULLIFY(equations_mapping%SOURCE_MAPPING%SOURCE_VARIABLE_MAPPING)
3359  equations_mapping%SOURCE_MAPPING%SOURCE_COEFFICIENT=1.0_dp
3360  ENDIF
3361  ELSE
3362  CALL flagerror("Equations is not associated.",err,error,*998)
3363  ENDIF
3364 
3365  exits("EQUATIONS_MAPPING_SOURCE_MAPPING_INITIALISE")
3366  RETURN
3367 999 CALL equations_mapping_source_mapping_finalise(equations_mapping%SOURCE_MAPPING,dummy_err,dummy_error,*998)
3368 998 errorsexits("EQUATIONS_MAPPING_SOURCE_MAPPING_INITIALISE",err,error)
3369  RETURN 1
3371 
3372  !
3373  !================================================================================================================================
3374  !
3375 
3377  SUBROUTINE equations_mapping_source_variable_type_set(EQUATIONS_MAPPING,SOURCE_VARIABLE_TYPE,ERR,ERROR,*)
3379  !Argument variables
3380  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3381  INTEGER(INTG), INTENT(IN) :: SOURCE_VARIABLE_TYPE
3382  INTEGER(INTG), INTENT(OUT) :: ERR
3383  TYPE(varying_string), INTENT(OUT) :: ERROR
3384  !Local Variables
3385  TYPE(equations_type), POINTER :: EQUATIONS
3386  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3387  TYPE(field_type), POINTER :: SOURCE_FIELD
3388  TYPE(varying_string) :: LOCAL_ERROR
3389 
3390  enters("EQUATIONS_MAPPING_SOURCE_VARIABLE_TYPE_SET",err,error,*999)
3391 
3392  IF(ASSOCIATED(equations_mapping)) THEN
3393  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
3394  CALL flagerror("Equations mapping have been finished.",err,error,*999)
3395  ELSE
3396  IF(ASSOCIATED(equations_mapping%CREATE_VALUES_CACHE)) THEN
3397  IF(source_variable_type==0) THEN
3398  equations_mapping%CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE=0
3399  ELSE
3400  equations=>equations_mapping%EQUATIONS
3401  IF(ASSOCIATED(equations)) THEN
3402  equations_set=>equations%EQUATIONS_SET
3403  IF(ASSOCIATED(equations_set)) THEN
3404  IF(ASSOCIATED(equations_set%SOURCE)) THEN
3405  source_field=>equations_set%SOURCE%SOURCE_FIELD
3406  IF(ASSOCIATED(source_field)) THEN
3407  !Check the source variable type is defined on the source field
3408  IF(source_variable_type>=1.AND.source_variable_type<=field_number_of_variable_types) THEN
3409  IF(ASSOCIATED(source_field%VARIABLE_TYPE_MAP(source_variable_type)%PTR)) THEN
3410  equations_mapping%CREATE_VALUES_CACHE%SOURCE_VARIABLE_TYPE=source_variable_type
3411  ELSE
3412  local_error="The specified source variable type of "// &
3413  & trim(numbertovstring(source_variable_type,"*",err,error))// &
3414  & " is not defined on the source field."
3415  CALL flagerror(local_error,err,error,*999)
3416  ENDIF
3417  ELSE
3418  local_error="The specified source variable type of "// &
3419  & trim(numbertovstring(source_variable_type,"*",err,error))// &
3420  & " is invalid. The number must either be zero or >= 1 and <= "// &
3421  & trim(numbertovstring(field_number_of_variable_types,"*",err,error))//"."
3422  CALL flagerror(local_error,err,error,*999)
3423  ENDIF
3424  ELSE
3425  CALL flagerror("Source field is not associated",err,error,*999)
3426  ENDIF
3427  ELSE
3428  CALL flagerror("Equations set source is not associated.",err,error,*999)
3429  ENDIF
3430  ELSE
3431  CALL flagerror("Equations equations set is not associated.",err,error,*999)
3432  ENDIF
3433  ELSE
3434  CALL flagerror("Equations mapping equations is not associated.",err,error,*999)
3435  ENDIF
3436  ENDIF
3437  ELSE
3438  CALL flagerror("Equations mapping create values cache is not associated",err,error,*999)
3439  ENDIF
3440  ENDIF
3441  ELSE
3442  CALL flagerror("Equations mapping is not associated",err,error,*999)
3443  ENDIF
3444 
3445  exits("EQUATIONS_MAPPING_SOURCE_VARIABLE_TYPE_SET")
3446  RETURN
3447 999 errorsexits("EQUATIONS_MAPPING_SOURCE_VARIABLE_TYPE_SET",err,error)
3448  RETURN 1
3450 
3451  !
3452  !================================================================================================================================
3453  !
3454 
3456  SUBROUTINE equationsmapping_vartoequatscolumnmapfinalise(VAR_TO_EQUATIONS_COLUMN_MAP,ERR,ERROR,*)
3458  !Argument variables
3459  TYPE(var_to_equations_column_map_type) :: VAR_TO_EQUATIONS_COLUMN_MAP
3460  INTEGER(INTG), INTENT(OUT) :: ERR
3461  TYPE(varying_string), INTENT(OUT) :: ERROR
3462  !Local Variables
3463 
3464  enters("EquationsMapping_VarToEquatsColumnMapFinalise",err,error,*999)
3465 
3466  IF(ALLOCATED(var_to_equations_column_map%COLUMN_DOF)) &
3467  & DEALLOCATE(var_to_equations_column_map%COLUMN_DOF)
3468 
3469  exits("EquationsMapping_VarToEquatsColumnMapFinalise")
3470  RETURN
3471 999 errors("EquationsMapping_VarToEquatsColumnMapFinalise",err,error)
3472  exits("EquationsMapping_VarToEquatsColumnMapFinalise")
3473  RETURN 1
3474 
3476 
3477  !
3478  !================================================================================================================================
3479  !
3480 
3482  SUBROUTINE equationsmapping_vartoequatsjacobianmapfinalise(VAR_TO_EQUATIONS_JACOBIAN_MAP,ERR,ERROR,*)
3484  !Argument variables
3485  TYPE(var_to_equations_jacobian_map_type) :: VAR_TO_EQUATIONS_JACOBIAN_MAP
3486  INTEGER(INTG), INTENT(OUT) :: ERR
3487  TYPE(varying_string), INTENT(OUT) :: ERROR
3488  !Local Variables
3489 
3490  enters("EquationsMapping_VarToEquatsJacobianMapFinalise",err,error,*999)
3491 
3492  IF(ALLOCATED(var_to_equations_jacobian_map%DOF_TO_COLUMNS_MAP)) &
3493  & DEALLOCATE(var_to_equations_jacobian_map%DOF_TO_COLUMNS_MAP)
3494  IF(ALLOCATED(var_to_equations_jacobian_map%DOF_TO_ROWS_MAP)) &
3495  & DEALLOCATE(var_to_equations_jacobian_map%DOF_TO_ROWS_MAP)
3496 
3497  exits("EquationsMapping_VarToEquatsJacobianMapFinalise")
3498  RETURN
3499 999 errors("EquationsMapping_VarToEquatsJacobianMapFinalise",err,error)
3500  exits("EquationsMapping_VarToEquatsJacobianMapFinalise")
3501  RETURN 1
3502 
3504 
3505  !
3506  !================================================================================================================================
3507  !
3508 
3510  SUBROUTINE equationsmapping_vartoequatsjacobianmapinitialise(VAR_TO_EQUATIONS_JACOBIAN_MAP,ERR,ERROR,*)
3512  !Argument variables
3513  TYPE(var_to_equations_jacobian_map_type) :: VAR_TO_EQUATIONS_JACOBIAN_MAP
3514  INTEGER(INTG), INTENT(OUT) :: ERR
3515  TYPE(varying_string), INTENT(OUT) :: ERROR
3516  !Local Variables
3517 
3518  enters("EquationsMapping_VarToEquatsJacobianMapInitialise",err,error,*999)
3519 
3520  var_to_equations_jacobian_map%VARIABLE_TYPE=0
3521  NULLIFY(var_to_equations_jacobian_map%VARIABLE)
3522 
3523  exits("EquationsMapping_VarToEquatsJacobianMapInitialise")
3524  RETURN
3525 999 errors("EquationsMapping_VarToEquatsJacobianMapInitialise",err,error)
3526  exits("EquationsMapping_VarToEquatsJacobianMapInitialise")
3527  RETURN 1
3528 
3530 
3531  !
3532  !================================================================================================================================
3533  !
3534 
3536  SUBROUTINE equationsmapping_vartoequatsmatricesmapfinalise(VAR_TO_EQUATIONS_MATRICES_MAP,ERR,ERROR,*)
3538  !Argument variables
3539  TYPE(var_to_equations_matrices_map_type) :: VAR_TO_EQUATIONS_MATRICES_MAP
3540  INTEGER(INTG), INTENT(OUT) :: ERR
3541  TYPE(varying_string), INTENT(OUT) :: ERROR
3542  !Local Variables
3543  INTEGER(INTG) :: matrix_idx
3544 
3545  enters("EquationsMapping_VarToEquatsMatricesMapFinalise",err,error,*999)
3546 
3547  IF(ALLOCATED(var_to_equations_matrices_map%EQUATIONS_MATRIX_NUMBERS)) &
3548  & DEALLOCATE(var_to_equations_matrices_map%EQUATIONS_MATRIX_NUMBERS)
3549  IF(ALLOCATED(var_to_equations_matrices_map%DOF_TO_COLUMNS_MAPS)) THEN
3550  DO matrix_idx=1,SIZE(var_to_equations_matrices_map%DOF_TO_COLUMNS_MAPS,1)
3551  CALL equationsmapping_vartoequatscolumnmapfinalise(var_to_equations_matrices_map%DOF_TO_COLUMNS_MAPS( &
3552  & matrix_idx),err,error,*999)
3553  ENDDO !matrix_idx
3554  DEALLOCATE(var_to_equations_matrices_map%DOF_TO_COLUMNS_MAPS)
3555  ENDIF
3556  IF(ALLOCATED(var_to_equations_matrices_map%DOF_TO_ROWS_MAP)) &
3557  & DEALLOCATE(var_to_equations_matrices_map%DOF_TO_ROWS_MAP)
3558 
3559  exits("EquationsMapping_VarToEquatsMatricesMapFinalise")
3560  RETURN
3561 999 errors("EquationsMapping_VarToEquatsMatricesMapFinalise",err,error)
3562  exits("EquationsMapping_VarToEquatsMatricesMapFinalise")
3563  RETURN 1
3564 
3566 
3567  !
3568  !================================================================================================================================
3569  !
3570 
3572  SUBROUTINE equationsmapping_vartoequatsmatricesmapinitialise(VAR_TO_EQUATIONS_MATRICES_MAP,ERR,ERROR,*)
3574  !Argument variables
3575  TYPE(var_to_equations_matrices_map_type) :: VAR_TO_EQUATIONS_MATRICES_MAP
3576  INTEGER(INTG), INTENT(OUT) :: ERR
3577  TYPE(varying_string), INTENT(OUT) :: ERROR
3578  !Local Variables
3579 
3580  enters("EquationsMapping_VarToEquatsMatricesMapInitialise",err,error,*999)
3581 
3582  var_to_equations_matrices_map%VARIABLE_INDEX=0
3583  var_to_equations_matrices_map%VARIABLE_TYPE=0
3584  NULLIFY(var_to_equations_matrices_map%VARIABLE)
3585  var_to_equations_matrices_map%NUMBER_OF_EQUATIONS_MATRICES=0
3586 
3587  exits("EquationsMapping_VarToEquatsMatricesMapInitialise")
3588  RETURN
3589 999 errors("EquationsMapping_VarToEquatsMatricesMapInitialise",err,error)
3590  exits("EquationsMapping_VarToEquatsMatricesMapInitialise")
3591  RETURN 1
3592 
3594 
3595  !
3596  !================================================================================================================================
3597  !
3598 
3599 END MODULE equations_mapping_routines
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Write a string followed by a value to a given output stream.
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
subroutine equationsmapping_vartoequatsjacobianmapfinalise(VAR_TO_EQUATIONS_JACOBIAN_MAP, ERR, ERROR,)
Finalises a variable to equations Jacobian map and deallocates all memory.
subroutine equations_mapping_rhs_mapping_initialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises the equations mapping RHS mapping.
subroutine equations_mapping_source_mapping_finalise(SOURCE_MAPPING, ERR, ERROR,)
Finalises the equations mapping source mapping and deallocates all memory.
subroutine, public equations_mapping_source_coeff_set(EQUATIONS_MAPPING, SOURCE_COEFFICIENT, ERR, ERROR,)
Sets the coefficient applied to the equations set source vector.
subroutine equations_mapping_initialise(EQUATIONS, ERR, ERROR,)
Initialises the equations mapping and deallocates all memory.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine equations_mapping_source_mapping_initialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises the equations mapping source mapping.
subroutine equations_mapping_finalise(EQUATIONS_MAPPING, ERR, ERROR,)
Finalises the equations mapping and deallocates all memory.
Contains information for a field defined on a region.
Definition: types.f90:1346
Contains information for mapping an equations matrix to a field variable.
Definition: types.f90:1559
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine equationsmapping_vartoequatsmatricesmapinitialise(VAR_TO_EQUATIONS_MATRICES_MAP, ERR, ERROR,)
Initialise an equations mapping equations matrix map.
Contains information on the create values cache for the equations mapping. Because we do not want to ...
Definition: types.f90:1660
Contains the information about the mapping of a variable DOF to an equations matrix column...
Definition: types.f90:1543
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
Flags a warning to the user.
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
subroutine equationsmapping_nonlinearmappingfinalise(NONLINEAR_MAPPING, ERR, ERROR,)
Finalises the equations mapping nonlinear mapping and deallocates all memory.
subroutine equationsmapping_createvaluescacheinitialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises an equations mapping create values cache.
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
subroutine equations_mapping_dynamic_matrices_set_1(EQUATIONS_MAPPING, DAMPING_MATRIX, STIFFNESS_MATRIX, ERR, ERROR,)
Sets/changes the matrices involved in a first order dynamic equations mapping.
integer(intg), parameter equations_second_order_dynamic
The equations are a second order dynamic.
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
subroutine equationsmapping_dynamicmatricescoeffsset1(EQUATIONS_MAPPING, DAMPING_MATRIX_COEFFICIENT, STIFFNESS_MATRIX_COEFFICIENT, ERR, ERROR,)
Sets/changes the matrix coefficients in a first order dynamic equations mapping.
Contains information on the equations mapping for a source i.e., how a field variable is mapped to th...
Definition: types.f90:1647
subroutine equationsmapping_equatsmatrixtovarmapinitialise(EQUATIONS_MATRIX_TO_VAR_MAP, ERR, ERROR,)
Initialise an equations matrix to variable maps.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
subroutine equations_mapping_linear_mapping_finalise(LINEAR_MAPPING, ERR, ERROR,)
Finalises the equations mapping linear mapping and deallocates all memory.
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
Contains the mapping from the Jacobian back to the nonlinear residual variables.
Definition: types.f90:1599
Write a string to a given output stream.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine equations_mapping_dynamic_matrices_set_all(EQUATIONS_MAPPING, MASS_MATRIX, DAMPING_MATRIX, STIFFNESS_MATRIX, ERR, ERROR,)
Sets/changes the matrices involved in dynamic equations mapping.
Contains the mapping for a dependent variable type to the equations matrices.
Definition: types.f90:1548
subroutine, public equations_mapping_destroy(EQUATIONS_MAPPING, ERR, ERROR,)
Destroy an equations mapping.
subroutine equationsmapping_dynamicmatricescoeffsset2(EQUATIONS_MAPPING, MASS_MATRIX_COEFFICIENT, DAMPING_MATRIX_COEFFICIENT, STIFFNESS_MATRIX_COEFFICIENT, ERR, ERROR,)
Sets/changes the matrix coefficients in a second order dynamic equations mapping. ...
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
subroutine, public equationsmapping_linearmatricescoeffsset(EQUATIONS_MAPPING, LINEAR_MATRIX_COEFFICIENTS, ERR, ERROR,)
Sets the coefficients for the linear equations matrices in an equation set.
subroutine, public equations_mapping_source_variable_type_set(EQUATIONS_MAPPING, SOURCE_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a source field variable and the equations set source vector.
subroutine equations_mapping_dynamic_matrices_set_2(EQUATIONS_MAPPING, MASS_MATRIX, DAMPING_MATRIX, STIFFNESS_MATRIX, ERR, ERROR,)
Sets/changes the matrices involved in a second order dynamic equations mapping.
This module handles all domain mappings routines.
This module handles all equations mapping routines.
subroutine equations_mapping_dynamic_mapping_finalise(DYNAMIC_MAPPING, ERR, ERROR,)
Finalises the equations mapping dynamic mapping and deallocates all memory.
subroutine equationsmapping_equatsjacobiantovarmapfinalise(EQUATIONS_JACOBIAN_TO_VAR_MAP, ERR, ERROR,)
Finalises a variable to equations Jacobian map and deallocates all memory.
integer(intg), parameter equations_linear
The equations are linear.
subroutine equations_mapping_rhs_mapping_finalise(RHS_MAPPING, ERR, ERROR,)
Finalises the equations mapping RHS mapping and deallocates all memory.
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
subroutine equationsmapping_vartoequatsjacobianmapinitialise(VAR_TO_EQUATIONS_JACOBIAN_MAP, ERR, ERROR,)
Initialises a variable to equations Jacobian map.
subroutine equationsmapping_vartoequatscolumnmapfinalise(VAR_TO_EQUATIONS_COLUMN_MAP, ERR, ERROR,)
Finalise an equations mapping equations matrix map.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
subroutine equationsmapping_dynamicmappinginitialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises the equations mapping dynamic mapping.
subroutine equationsmapping_nonlinearmappinginitialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises the equations mapping nonlinear mapping.
subroutine equations_mapping_linear_mapping_initialise(EQUATIONS_MAPPING, ERR, ERROR,)
Initialises the equations mapping linear mapping.
Write a string followed by a vector to a specified output stream.
subroutine equationsmapping_equatsjacobiantovarmapinitialise(EQUATIONS_JACOBIAN_TO_VAR_MAP, ERR, ERROR,)
Initialises a variable to equations Jacobian map.
subroutine, public equationsmapping_residualvariablesnumberset(EQUATIONS_MAPPING, NUMBER_OF_VARIABLES, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set residual vector...
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
subroutine, public equations_mapping_residual_coeff_set(EQUATIONS_MAPPING, RESIDUAL_COEFFICIENT, ERR, ERROR,)
Sets the coefficient applied to the equations set residual vector.
Contains the mapping for a dependent variable type to the nonlinear Jacobian matrix.
Definition: types.f90:1611
Contains information for a field variable defined on a field.
Definition: types.f90:1289
subroutine equationsmapping_equationsmatrixtovarmapfinalise(EQUATIONS_MATRIX_TO_VAR_MAP, ERR, ERROR,)
Finalise an equations matrix to variable maps and deallocate all memory.
integer(intg), parameter equations_nonlinear_bcs
The equations have non-linear boundary conditions.
subroutine equations_mapping_calculate(EQUATIONS_MAPPING, ERR, ERROR,)
Calculates the equations/dofs mapping.
Contains information on the equations mapping for a RHS i.e., how a field variable is mapped to the R...
Definition: types.f90:1635
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
Flags an error condition.
subroutine, public equationsmapping_residualvariabletypesset(EQUATIONS_MAPPING, RESIDUAL_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set residual vector...
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Flags an error condition.
subroutine equationsmapping_vartoequatsmatricesmapfinalise(VAR_TO_EQUATIONS_MATRICES_MAP, ERR, ERROR,)
Finalises a variable to equations matrices map and deallocates all memory.
subroutine equationsmapping_createvaluescachefinalise(CREATE_VALUES_CACHE, ERR, ERROR,)
Finalises an equations mapping create values cache and deallocates all memory.
integer(intg), parameter equations_nonlinear
The equations are non-linear.
integer(intg), parameter equations_time_stepping
The equations are for time stepping.
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
This module contains all kind definitions.
Definition: kinds.f90:45
subroutine, public equations_mapping_rhs_coeff_set(EQUATIONS_MAPPING, RHS_COEFFICIENT, ERR, ERROR,)
Sets the coefficient applied to the equations set RHS vector.
This module handles all formating and input and output.