OpenCMISS-Iron Internal API Documentation
equations_matrices_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE equations_matrices_routines
46 
47  USE base_routines
48  USE distributed_matrix_vector
49  USE equations_set_constants
50  USE field_routines
51  USE iso_varying_string
52  USE kinds
53  USE lists
54  USE matrix_vector
55  USE strings
56  USE types
57  USE linkedlist_routines
58 
59 #include "macros.h"
60 
61  IMPLICIT NONE
62 
63  PRIVATE
64 
65  !Module parameters
66 
71  INTEGER(INTG), PARAMETER :: equations_matrix_no_structure=1
72  INTEGER(INTG), PARAMETER :: equations_matrix_fem_structure=2
73  INTEGER(INTG), PARAMETER :: equations_matrix_diagonal_structure=3
74  INTEGER(INTG), PARAMETER :: equations_matrix_nodal_structure=4
76 
77 
82  INTEGER(INTG), PARAMETER :: equations_matrix_unlumped=1
83  INTEGER(INTG), PARAMETER :: equations_matrix_lumped=2
85 
90  INTEGER(INTG), PARAMETER :: equations_matrices_sparse_matrices=1
91  INTEGER(INTG), PARAMETER :: equations_matrices_full_matrices=2
93 
98  INTEGER(INTG), PARAMETER :: equations_matrices_all=1
99  INTEGER(INTG), PARAMETER :: equations_matrices_dynamic_only=2
100  INTEGER(INTG), PARAMETER :: equations_matrices_linear_only=3
101  INTEGER(INTG), PARAMETER :: equations_matrices_nonlinear_only=4
102  INTEGER(INTG), PARAMETER :: equations_matrices_jacobian_only=5
103  INTEGER(INTG), PARAMETER :: equations_matrices_residual_only=6
104  INTEGER(INTG), PARAMETER :: equations_matrices_rhs_only=7
105  INTEGER(INTG), PARAMETER :: equations_matrices_source_only=8
106  INTEGER(INTG), PARAMETER :: equations_matrices_rhs_residual_only=9
107  INTEGER(INTG), PARAMETER :: equations_matrices_rhs_source_only=10
108  INTEGER(INTG), PARAMETER :: equations_matrices_residual_source_only=11
109  INTEGER(INTG), PARAMETER :: equations_matrices_vectors_only=12
111 
115  INTEGER(INTG), PARAMETER :: equations_jacobian_finite_difference_calculated=1
116  INTEGER(INTG), PARAMETER :: equations_jacobian_analytic_calculated=2
119 
120  !Module types
121 
122  !Module variables
123 
124  !Interfaces
125 
126  INTERFACE equationsmatrices_createfinish
127  MODULE PROCEDURE equations_matrices_create_finish
128  END INTERFACE equationsmatrices_createfinish
129 
130  INTERFACE equationsmatrices_createstart
131  MODULE PROCEDURE equations_matrices_create_start
132  END INTERFACE equationsmatrices_createstart
133 
134  INTERFACE equationsmatrices_destroy
135  MODULE PROCEDURE equations_matrices_destroy
136  END INTERFACE equationsmatrices_destroy
137 
138  INTERFACE equationsmatrices_dynamiclumpingtypeset
139  MODULE PROCEDURE equations_matrices_dynamic_lumping_type_set
140  END INTERFACE equationsmatrices_dynamiclumpingtypeset
141 
142  INTERFACE equationsmatrices_dynamicstoragetypeset
143  MODULE PROCEDURE equations_matrices_dynamic_storage_type_set
144  END INTERFACE equationsmatrices_dynamicstoragetypeset
145 
146  INTERFACE equationsmatrices_elementinitialise
147  MODULE PROCEDURE equations_matrices_element_initialise
148  END INTERFACE equationsmatrices_elementinitialise
149 
150  INTERFACE equationsmatrices_elementfinalise
151  MODULE PROCEDURE equations_matrices_element_finalise
152  END INTERFACE equationsmatrices_elementfinalise
153 
154  INTERFACE equationsmatrices_elementadd
155  MODULE PROCEDURE equations_matrices_element_add
156  END INTERFACE equationsmatrices_elementadd
157 
158  INTERFACE equationsmatrices_jacobianelementadd
159  MODULE PROCEDURE equations_matrices_jacobian_element_add
160  END INTERFACE equationsmatrices_jacobianelementadd
161 
162  INTERFACE equationsmatrices_elementcalculate
163  MODULE PROCEDURE equations_matrices_element_calculate
164  END INTERFACE equationsmatrices_elementcalculate
165 
166  INTERFACE equationsmatrices_valuesinitialise
167  MODULE PROCEDURE equations_matrices_values_initialise
168  END INTERFACE equationsmatrices_valuesinitialise
169 
170  INTERFACE equationsmatrices_elementmatrixfinalise
171  MODULE PROCEDURE equations_matrices_element_matrix_finalise
172  END INTERFACE equationsmatrices_elementmatrixfinalise
173 
174  INTERFACE equationsmatrices_elementmatrixcalculate
175  MODULE PROCEDURE equations_matrices_element_matrix_calculate
176  END INTERFACE equationsmatrices_elementmatrixcalculate
177 
178  INTERFACE equationsmatrices_elementmatrixsetup
179  MODULE PROCEDURE equations_matrices_element_matrix_setup
180  END INTERFACE equationsmatrices_elementmatrixsetup
181 
182  INTERFACE equationsmatrices_elementvectorfinalise
183  MODULE PROCEDURE equations_matrices_element_vector_finalise
184  END INTERFACE equationsmatrices_elementvectorfinalise
185 
186  INTERFACE equationsmatrices_elementvectorcalculate
187  MODULE PROCEDURE equations_matrices_element_vector_calculate
188  END INTERFACE equationsmatrices_elementvectorcalculate
189 
190  INTERFACE equationsmatrices_elementvectorsetup
191  MODULE PROCEDURE equations_matrices_element_vector_setup
192  END INTERFACE equationsmatrices_elementvectorsetup
193 
194  INTERFACE equationsmatrices_linearstoragetypeset
195  MODULE PROCEDURE equations_matrices_linear_storage_type_set
196  END INTERFACE equationsmatrices_linearstoragetypeset
197 
199  INTERFACE equationsmatrices_nonlinearstoragetypeset
200  MODULE PROCEDURE equationsmatrices_nonlinearstoragetypeset0
201  MODULE PROCEDURE equationsmatrices_nonlinearstoragetypeset1
202  END INTERFACE equationsmatrices_nonlinearstoragetypeset
203 
205  INTERFACE equationsmatrices_nonlinearstructuretypeset
206  MODULE PROCEDURE equationsmatrices_nonlinearstructuretypeset0
207  MODULE PROCEDURE equationsmatrices_nonlinearstructuretypeset1
208  END INTERFACE equationsmatrices_nonlinearstructuretypeset
209 
210  INTERFACE equationsmatrices_output
211  MODULE PROCEDURE equations_matrices_output
212  END INTERFACE equationsmatrices_output
213 
214  INTERFACE equationsmatrices_jacobianoutput
215  MODULE PROCEDURE equations_matrices_jacobian_output
216  END INTERFACE equationsmatrices_jacobianoutput
217 
218  PUBLIC equations_matrix_no_structure,equations_matrix_fem_structure,equations_matrix_diagonal_structure, &
219  & equations_matrix_nodal_structure
220 
221  PUBLIC equations_matrix_unlumped,equations_matrix_lumped
222 
223  PUBLIC equations_matrices_sparse_matrices,equations_matrices_full_matrices
224 
225  PUBLIC equations_matrices_all,equations_matrices_linear_only,equations_matrices_nonlinear_only,equations_matrices_jacobian_only, &
226  & equations_matrices_residual_only,equations_matrices_rhs_only,equations_matrices_source_only, &
227  & equations_matrices_rhs_residual_only,equations_matrices_rhs_source_only,equations_matrices_residual_source_only, &
228  & equations_matrices_vectors_only
229 
230  PUBLIC equations_jacobian_finite_difference_calculated,equations_jacobian_analytic_calculated
231 
232  PUBLIC equations_matrices_create_finish,equations_matrices_create_start
233 
234  PUBLIC equationsmatrices_createfinish,equationsmatrices_createstart
235 
236  PUBLIC equations_matrices_destroy
237 
238  PUBLIC equationsmatrices_destroy
239 
240  PUBLIC equations_matrices_dynamic_lumping_type_set,equations_matrices_dynamic_storage_type_set
241 
242  PUBLIC equationsmatrices_dynamiclumpingtypeset,equationsmatrices_dynamicstoragetypeset,equationsmatrices_dynamicstructuretypeset
243 
244  !!TODO check if the elements should be create/destroy rather than initialise/finalise
245  PUBLIC equations_matrices_element_initialise,equations_matrices_element_finalise
246 
247  PUBLIC equationsmatrices_elementinitialise,equationsmatrices_elementfinalise
248 
249  PUBLIC equations_matrices_element_add,equations_matrices_jacobian_element_add,equations_matrices_element_calculate, &
250  & equations_matrices_values_initialise
251 
252  PUBLIC equationsmatrices_elementadd,equationsmatrices_jacobianelementadd,equationsmatrices_elementcalculate, &
253  & equationsmatrices_valuesinitialise
254 
255  PUBLIC equations_matrices_element_matrix_finalise
256 
257  PUBLIC equationsmatrices_elementmatrixfinalise,equationsmatrices_elementmatrixinitialise
258 
259  PUBLIC equations_matrices_element_matrix_calculate,equations_matrices_element_matrix_setup
260 
261  PUBLIC equationsmatrices_elementmatrixcalculate,equationsmatrices_elementmatrixsetup
262 
263  PUBLIC equations_matrices_element_vector_finalise
264 
265  PUBLIC equationsmatrices_elementvectorfinalise,equationsmatrices_elementvectorinitialise
266 
267  PUBLIC equations_matrices_element_vector_calculate,equations_matrices_element_vector_setup
268 
269  PUBLIC equationsmatrices_elementvectorcalculate,equationsmatrices_elementvectorsetup
270 
271  PUBLIC equationsmatrices_jacobiantypesset
272 
273  PUBLIC equations_matrices_linear_storage_type_set
274 
275  PUBLIC equationsmatrices_linearstoragetypeset,equationsmatrices_linearstructuretypeset
276 
277  PUBLIC equationsmatrices_nodalinitialise,equationsmatrices_nodalfinalise
278 
279  PUBLIC equationsmatrices_nodeadd,equationsmatrices_jacobiannodeadd,equationsmatrices_nodalcalculate
280 
281  PUBLIC equationsmatrices_nodalmatrixfinalise,equationsmatrices_nodalmatrixinitialise
282 
283  PUBLIC equationsmatrices_nodalmatrixcalculate,equationsmatrices_nodalmatrixsetup
284 
285  PUBLIC equationsmatrices_nodalvectorfinalise,equationsmatrices_nodalvectorinitialise
286 
287  PUBLIC equationsmatrices_nodalvectorcalculate,equationsmatrices_nodalvectorsetup
288 
289  PUBLIC equationsmatrices_nonlinearstoragetypeset,equationsmatrices_nonlinearstructuretypeset
290 
291  PUBLIC equations_matrices_output,equations_matrices_jacobian_output
292 
293  PUBLIC equationsmatrices_output,equationsmatrices_jacobianoutput
294 
295 CONTAINS
296 
297  !
298  !================================================================================================================================
299  !
300 
302  SUBROUTINE equations_jacobian_finalise(EQUATIONS_JACOBIAN,ERR,ERROR,*)
303 
304  !Argument variables
305  TYPE(equations_jacobian_type), POINTER :: EQUATIONS_JACOBIAN
306  INTEGER(INTG), INTENT(OUT) :: ERR
307  TYPE(varying_string), INTENT(OUT) :: ERROR
308  !Local Variables
309 
310  enters("EQUATIONS_JACOBIAN_FINALISE",err,error,*999)
311 
312  IF(ASSOCIATED(equations_jacobian)) THEN
313  IF(ASSOCIATED(equations_jacobian%JACOBIAN)) CALL distributed_matrix_destroy(equations_jacobian%JACOBIAN,err,error,*999)
314  CALL equations_matrices_element_matrix_finalise(equations_jacobian%ELEMENT_JACOBIAN,err,error,*999)
315  CALL equationsmatrices_nodalmatrixfinalise(equations_jacobian%NodalJacobian,err,error,*999)
316  ENDIF
317 
318  exits("EQUATIONS_JACOBIAN_FINALISE")
319  RETURN
320 999 errorsexits("EQUATIONS_JACOBIAN_FINALISE",err,error)
321  RETURN 1
322  END SUBROUTINE equations_jacobian_finalise
323 
324  !
325  !================================================================================================================================
326  !
327 
329  SUBROUTINE equations_jacobian_initialise(NONLINEAR_MATRICES,MATRIX_NUMBER,ERR,ERROR,*)
330 
331  !Argument variables
332  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
333  INTEGER(INTG), INTENT(IN) :: MATRIX_NUMBER
334  INTEGER(INTG), INTENT(OUT) :: ERR
335  TYPE(varying_string), INTENT(OUT) :: ERROR
336  !Local Variables
337  INTEGER(INTG) :: DUMMY_ERR
338  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
339  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
340  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
341  TYPE(varying_string) :: DUMMY_ERROR
342 
343  enters("EQUATIONS_JACOBIAN_INITIALISE",err,error,*998)
344 
345  IF(ASSOCIATED(nonlinear_matrices)) THEN
346  equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
347  IF(ASSOCIATED(equations_matrices)) THEN
348  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
349  IF(ASSOCIATED(equations_mapping)) THEN
350  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
351  IF(ASSOCIATED(nonlinear_mapping)) THEN
352  IF(ALLOCATED(nonlinear_matrices%JACOBIANS)) THEN
353  IF(ASSOCIATED(nonlinear_matrices%JACOBIANS(matrix_number)%PTR)) THEN
354  CALL flagerror("Nonlinear matrices Jacobian is already associated.",err,error,*998)
355  ELSE
356  ALLOCATE(nonlinear_matrices%JACOBIANS(matrix_number)%PTR,stat=err)
357  IF(err/=0) CALL flagerror("Could not allocate equations Jacobian.",err,error,*999)
358  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN_NUMBER=matrix_number
359  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%NONLINEAR_MATRICES=>nonlinear_matrices
360  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%STORAGE_TYPE=matrix_block_storage_type
361  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%STRUCTURE_TYPE=equations_matrix_no_structure
362  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%NUMBER_OF_COLUMNS= &
363  & nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_number)%NUMBER_OF_COLUMNS
364  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%UPDATE_JACOBIAN=.true.
365  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%FIRST_ASSEMBLY=.true.
366  nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_number)%JACOBIAN=>nonlinear_matrices%JACOBIANS(matrix_number)%PTR
367  NULLIFY(nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN)
368  CALL equationsmatrices_elementmatrixinitialise(nonlinear_matrices%JACOBIANS(matrix_number)%PTR% &
369  & element_jacobian,err,error,*999)
370  CALL equationsmatrices_nodalmatrixinitialise(nonlinear_matrices%JACOBIANS(matrix_number)%PTR% &
371  & nodaljacobian,err,error,*999)
372  nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN_CALCULATION_TYPE= &
373  & equations_jacobian_finite_difference_calculated
374  ENDIF
375  ELSE
376  CALL flagerror("Equations matrices nonlinear matrieces Jacobian is not allocated.",err,error,*999)
377  ENDIF
378  ELSE
379  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
380  ENDIF
381  ELSE
382  CALL flagerror("Equations mapping is not associated.",err,error,*998)
383  ENDIF
384  ELSE
385  CALL flagerror("Nonlinear matrices equations matrices is not associated.",err,error,*998)
386  ENDIF
387  ELSE
388  CALL flagerror("Nonlinear matrices is not associated.",err,error,*998)
389  ENDIF
390 
391  exits("EQUATIONS_JACOBIAN_INITIALISE")
392  RETURN
393 999 CALL equations_jacobian_finalise(nonlinear_matrices%JACOBIANS(matrix_number)%PTR,dummy_err,dummy_error,*998)
394 998 errorsexits("EQUATIONS_JACOBIAN_INITIALISE",err,error)
395  RETURN 1
396  END SUBROUTINE equations_jacobian_initialise
397 
398  !
399  !================================================================================================================================
400  !
401 
403  SUBROUTINE equations_matrices_create_finish(EQUATIONS_MATRICES,ERR,ERROR,*)
404 
405  !Argument variables
406  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
407  INTEGER(INTG), INTENT(OUT) :: ERR
408  TYPE(varying_string), INTENT(OUT) :: ERROR
409  !Local Variables
410  INTEGER(INTG) :: DUMMY_ERR,matrix_idx,NUMBER_OF_NON_ZEROS
411  INTEGER(INTG), POINTER :: ROW_INDICES(:),COLUMN_INDICES(:)
412  TYPE(domain_mapping_type), POINTER :: ROW_DOMAIN_MAP,COLUMN_DOMAIN_MAP
413  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
414  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
415  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
416  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
417  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
418  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
419  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
420  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
421  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
422  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
423  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
424  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
425  type(linkedlist),pointer :: list(:)
426  NULLIFY(row_indices)
427  NULLIFY(column_indices)
428 
429  enters("EQUATIONS_MATRICES_CREATE_FINISH",err,error,*998)
430 
431  IF(ASSOCIATED(equations_matrices)) THEN
432  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
433  CALL flagerror("Equations matrices have already been finished.",err,error,*998)
434  ELSE
435  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
436  IF(ASSOCIATED(equations_mapping)) THEN
437  row_domain_map=>equations_mapping%ROW_DOFS_MAPPING
438  IF(ASSOCIATED(row_domain_map)) THEN
439  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
440  IF(ASSOCIATED(dynamic_matrices)) THEN
441  !Dynamic matrices
442  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
443  IF(ASSOCIATED(dynamic_mapping)) THEN
444  !Now create the individual dynamic equations matrices
445  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
446  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
447  IF(ASSOCIATED(equations_matrix)) THEN
448  column_domain_map=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING
449  IF(ASSOCIATED(column_domain_map)) THEN
450  !Create the distributed equations matrix
451  CALL distributed_matrix_create_start(row_domain_map,column_domain_map,equations_matrices% &
452  & dynamic_matrices%MATRICES(matrix_idx)%PTR%MATRIX,err,error,*999)
453  CALL distributed_matrix_data_type_set(equations_matrix%MATRIX,matrix_vector_dp_type,err,error,*999)
454  CALL distributed_matrix_storage_type_set(equations_matrix%MATRIX,equations_matrix%STORAGE_TYPE,err,error,*999)
455  !Calculate and set the matrix structure/sparsity pattern
456  IF(equations_matrix%STORAGE_TYPE/=distributed_matrix_block_storage_type.AND. &
457  & equations_matrix%STORAGE_TYPE/=distributed_matrix_diagonal_storage_type) THEN
458  CALL equationsmatrix_structurecalculate(equations_matrix,number_of_non_zeros,row_indices,column_indices, &
459  & list,err,error,*999)
460  CALL distributed_matrix_linklist_set(equations_matrix%MATRIX,list,err,error,*999)
461  CALL distributed_matrix_number_non_zeros_set(equations_matrix%MATRIX,number_of_non_zeros,err,error,*999)
462  CALL distributed_matrix_storage_locations_set(equations_matrix%MATRIX,row_indices,column_indices, &
463  & err,error,*999)
464  IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
465  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
466  ENDIF
467  CALL distributed_matrix_create_finish(equations_matrix%MATRIX,err,error,*999)
468  ELSE
469  local_error="Column domain map for dynamic matrix number "// &
470  & trim(numbertovstring(matrix_idx,"*",err,error))//" is not associated."
471  CALL flagerror(local_error,err,error,*999)
472  ENDIF
473  ELSE
474  local_error="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
475  & " is not associated."
476  CALL flagerror(local_error,err,error,*999)
477  ENDIF
478  ENDDO !matrix_idx
479  ELSE
480  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
481  ENDIF
482  ENDIF
483  linear_matrices=>equations_matrices%LINEAR_MATRICES
484  IF(ASSOCIATED(linear_matrices)) THEN
485  !Linear matrices
486  linear_mapping=>equations_mapping%LINEAR_MAPPING
487  IF(ASSOCIATED(linear_mapping)) THEN
488  !Now create the individual linear equations matrices
489  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
490  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
491  IF(ASSOCIATED(equations_matrix)) THEN
492  column_domain_map=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING
493  IF(ASSOCIATED(column_domain_map)) THEN
494  !Create the distributed equations matrix
495  CALL distributed_matrix_create_start(row_domain_map,column_domain_map,equations_matrices% &
496  & linear_matrices%MATRICES(matrix_idx)%PTR%MATRIX,err,error,*999)
497  CALL distributed_matrix_data_type_set(equations_matrix%MATRIX,matrix_vector_dp_type,err,error,*999)
498  CALL distributed_matrix_storage_type_set(equations_matrix%MATRIX,equations_matrix%STORAGE_TYPE,err,error,*999)
499  !Calculate and set the matrix structure/sparsity pattern
500  IF(equations_matrix%STORAGE_TYPE/=distributed_matrix_block_storage_type.AND. &
501  & equations_matrix%STORAGE_TYPE/=distributed_matrix_diagonal_storage_type) THEN
502  CALL equationsmatrix_structurecalculate(equations_matrix,number_of_non_zeros,row_indices,column_indices, &
503  & list,err,error,*999)
504  CALL distributed_matrix_linklist_set(equations_matrix%MATRIX,list,err,error,*999)
505  CALL distributed_matrix_number_non_zeros_set(equations_matrix%MATRIX,number_of_non_zeros,err,error,*999)
506  CALL distributed_matrix_storage_locations_set(equations_matrix%MATRIX,row_indices,column_indices, &
507  & err,error,*999)
508  IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
509  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
510  ENDIF
511  CALL distributed_matrix_create_finish(equations_matrix%MATRIX,err,error,*999)
512  ELSE
513  local_error="Column domain map for linear matrix number "// &
514  & trim(numbertovstring(matrix_idx,"*",err,error))//" is not associated."
515  CALL flagerror(local_error,err,error,*999)
516  ENDIF
517  ELSE
518  local_error="Equations matrix for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
519  & " is not associated."
520  CALL flagerror(local_error,err,error,*999)
521  ENDIF
522  ENDDO !matrix_idx
523  ELSE
524  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
525  ENDIF
526  ENDIF
527  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
528  IF(ASSOCIATED(nonlinear_matrices)) THEN
529  !Nonlinear matrices
530  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
531  IF(ASSOCIATED(nonlinear_mapping)) THEN
532  !Set up the Jacobian matrices
533  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
534  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
535  IF(ASSOCIATED(jacobian_matrix)) THEN
536  column_domain_map=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%COLUMN_DOFS_MAPPING
537  IF(ASSOCIATED(column_domain_map)) THEN
538  !!TODO: Set the distributed matrix not to allocate the data if the Jacobian is not calculated.
539  !Create the distributed Jacobian matrix
540  CALL distributed_matrix_create_start(row_domain_map,column_domain_map,jacobian_matrix%JACOBIAN,err,error,*999)
541  CALL distributed_matrix_data_type_set(jacobian_matrix%JACOBIAN,matrix_vector_dp_type,err,error,*999)
542  CALL distributed_matrix_storage_type_set(jacobian_matrix%JACOBIAN,jacobian_matrix%STORAGE_TYPE,err,error,*999)
543  !Calculate and set the matrix structure/sparsity pattern
544  IF(jacobian_matrix%STORAGE_TYPE/=distributed_matrix_block_storage_type.AND. &
545  & jacobian_matrix%STORAGE_TYPE/=distributed_matrix_diagonal_storage_type) THEN
546  CALL jacobianmatrix_structurecalculate(jacobian_matrix,number_of_non_zeros,row_indices,column_indices, &
547  & err,error,*999)
548  CALL distributed_matrix_number_non_zeros_set(jacobian_matrix%JACOBIAN,number_of_non_zeros,err,error,*999)
549  CALL distributed_matrix_storage_locations_set(jacobian_matrix%JACOBIAN,row_indices,column_indices, &
550  & err,error,*999)
551  IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
552  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
553  ENDIF
554  CALL distributed_matrix_create_finish(jacobian_matrix%JACOBIAN,err,error,*999)
555  ELSE
556  CALL flagerror("Column domain map is not associated.",err,error,*999)
557  ENDIF
558  ELSE
559  local_error="Jacobian matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))//" is not associated."
560  CALL flagerror(local_error,err,error,*999)
561  ENDIF
562  ENDDO
563  !Set up the residual vector
564  CALL distributed_vector_create_start(row_domain_map,equations_matrices%NONLINEAR_MATRICES%RESIDUAL,err,error,*999)
565  CALL distributed_vector_data_type_set(nonlinear_matrices%RESIDUAL,matrix_vector_dp_type,err,error,*999)
566  CALL distributed_vector_create_finish(nonlinear_matrices%RESIDUAL,err,error,*999)
567  !Initialise the residual vector to zero for time dependent problems so that the previous residual is set to zero
568  CALL distributed_vector_all_values_set(nonlinear_matrices%RESIDUAL,0.0_dp,err,error,*999)
569  ELSE
570  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
571  ENDIF
572  ENDIF
573  rhs_vector=>equations_matrices%RHS_VECTOR
574  IF(ASSOCIATED(rhs_vector)) THEN
575  !Set up the equations RHS vector
576  CALL distributed_vector_create_start(row_domain_map,equations_matrices%RHS_VECTOR%VECTOR,err,error,*999)
577  CALL distributed_vector_data_type_set(rhs_vector%VECTOR,matrix_vector_dp_type,err,error,*999)
578  CALL distributed_vector_create_finish(rhs_vector%VECTOR,err,error,*999)
579  ENDIF
580  source_vector=>equations_matrices%SOURCE_VECTOR
581  IF(ASSOCIATED(source_vector)) THEN
582  !Set up the equations source vector
583  CALL distributed_vector_create_start(row_domain_map,equations_matrices%SOURCE_VECTOR%VECTOR,err,error,*999)
584  CALL distributed_vector_data_type_set(source_vector%VECTOR,matrix_vector_dp_type,err,error,*999)
585  CALL distributed_vector_create_finish(source_vector%VECTOR,err,error,*999)
586  ENDIF
587  !Finish up
588  equations_matrices%EQUATIONS_MATRICES_FINISHED=.true.
589  ELSE
590  CALL flagerror("Row domain map is not associated.",err,error,*999)
591  ENDIF
592  ELSE
593  CALL flagerror("Equations mapping is not associated.",err,error,*998)
594  ENDIF
595  ENDIF
596  ELSE
597  CALL flagerror("Equations matrices is not associated.",err,error,*998)
598  ENDIF
599 
600  exits("EQUATIONS_MATRICES_CREATE_FINISH")
601  RETURN
602 999 IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
603  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
604  CALL equations_matrices_finalise(equations_matrices,dummy_err,dummy_error,*998)
605 998 errorsexits("EQUATIONS_MATRICES_CREATE_FINISH",err,error)
606  RETURN 1
607  END SUBROUTINE equations_matrices_create_finish
608 
609  !
610  !================================================================================================================================
611  !
612 
614  SUBROUTINE equations_matrices_create_start(EQUATIONS,EQUATIONS_MATRICES,ERR,ERROR,*)
615 
616  !Argument variables
617  TYPE(equations_type), POINTER :: EQUATIONS
618  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
619  INTEGER(INTG), INTENT(OUT) :: ERR
620  TYPE(varying_string), INTENT(OUT) :: ERROR
621  !Local Variables
622  INTEGER(INTG) :: DUMMY_ERR
623  TYPE(varying_string) :: DUMMY_ERROR
624 
625  enters("EQUATIONS_MATRICES_CREATE_START",err,error,*998)
626 
627  IF(ASSOCIATED(equations)) THEN
628  IF(equations%EQUATIONS_FINISHED) THEN
629  IF(ASSOCIATED(equations_matrices)) THEN
630  CALL flagerror("Equations matrices is already associated.",err,error,*998)
631  ELSE
632  NULLIFY(equations_matrices)
633  !Initialise the equations matrices
634  CALL equations_matrices_initialise(equations,err,error,*999)
635  equations_matrices=>equations%EQUATIONS_MATRICES
636  ENDIF
637  ELSE
638  CALL flagerror("Equations has not been finished.",err,error,*999)
639  ENDIF
640  ELSE
641  CALL flagerror("Equations is not associated.",err,error,*998)
642  ENDIF
643 
644  exits("EQUATIONS_MATRICES_CREATE_START")
645  RETURN
646 999 CALL equations_matrices_finalise(equations%EQUATIONS_MATRICES,dummy_err,dummy_error,*998)
647 998 errorsexits("EQUATIONS_MATRICES_CREATE_START",err,error)
648  RETURN 1
649  END SUBROUTINE equations_matrices_create_start
650 
651  !
652  !================================================================================================================================
653  !
654 
656  SUBROUTINE equations_matrices_destroy(EQUATIONS_MATRICES,ERR,ERROR,*)
657 
658  !Argument variables
659  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
660  INTEGER(INTG), INTENT(OUT) :: ERR
661  TYPE(varying_string), INTENT(OUT) :: ERROR
662  !Local Variables
663 
664  enters("EQUATIONS_MATRICES_DESTROY",err,error,*999)
665 
666  IF(ASSOCIATED(equations_matrices)) THEN
667  CALL equations_matrices_finalise(equations_matrices,err,error,*999)
668  ELSE
669  CALL flagerror("Equations matrices is not associated",err,error,*999)
670  ENDIF
671 
672  exits("EQUATIONS_MATRICES_DESTROY")
673  RETURN
674 999 errorsexits("EQUATIONS_MATRICES_DESTROY",err,error)
675  RETURN 1
676 
677  END SUBROUTINE equations_matrices_destroy
678 
679  !
680  !================================================================================================================================
681  !
682 
684  SUBROUTINE equations_matrices_element_matrix_calculate(ELEMENT_MATRIX,UPDATE_MATRIX,ROW_ELEMENT_NUMBERS,COLUMN_ELEMENT_NUMBERS, &
685  & rows_field_variable,cols_field_variable,err,error,*)
686 
687  !Argument variables
688  TYPE(element_matrix_type) :: ELEMENT_MATRIX
689  LOGICAL :: UPDATE_MATRIX
690  INTEGER(INTG), INTENT(IN) :: ROW_ELEMENT_NUMBERS(:)
691  INTEGER(INTG), INTENT(IN) :: COLUMN_ELEMENT_NUMBERS(:)
692  TYPE(field_variable_type), POINTER :: ROWS_FIELD_VARIABLE
693  TYPE(field_variable_type), POINTER :: COLS_FIELD_VARIABLE
694  INTEGER(INTG), INTENT(OUT) :: ERR
695  TYPE(varying_string), INTENT(OUT) :: ERROR
696  !Local Variables
697  INTEGER(INTG) :: component_idx,derivative,derivative_idx,global_ny,local_ny,node,node_idx,version,dataPointIdx, &
698  & localDataPointNumber,elementIdx,rowElementNumber,colElementNumber
699  TYPE(basis_type), POINTER :: BASIS
700  TYPE(domain_elements_type), POINTER :: ELEMENTS_TOPOLOGY
701  TYPE(decompositiondatapointstype), POINTER :: decompositionData
702  TYPE(varying_string) :: LOCAL_ERROR
703 
704  enters("EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE",err,error,*999)
705 
706  IF(ASSOCIATED(rows_field_variable)) THEN
707  IF(ASSOCIATED(cols_field_variable)) THEN
708  element_matrix%NUMBER_OF_ROWS=0
709  element_matrix%NUMBER_OF_COLUMNS=0
710  IF(update_matrix) THEN
711  IF(ASSOCIATED(rows_field_variable,cols_field_variable)) THEN
712  !Row and columns variable is the same.
713  DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
714  elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
715  DO elementidx=1,SIZE(row_element_numbers)
716  rowelementnumber=row_element_numbers(elementidx)
717  IF(rowelementnumber>=1.AND.rowelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS) THEN
718  SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
719  CASE(field_constant_interpolation)
720  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
721  global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
722  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
723  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
724  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
725  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
726  CASE(field_element_based_interpolation)
727  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
728  & elements(rowelementnumber)
729  global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
730  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
731  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
732  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
733  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
734  CASE(field_node_based_interpolation)
735  basis=>elements_topology%ELEMENTS(rowelementnumber)%BASIS
736  DO node_idx=1,basis%NUMBER_OF_NODES
737  node=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_NODES(node_idx)
738  DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
739  derivative=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
740  version=elements_topology%ELEMENTS(rowelementnumber)%elementVersions(derivative_idx,node_idx)
741  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
742  & derivatives(derivative)%VERSIONS(version)
743  global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
744  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
745  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
746  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
747  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
748  ENDDO !derivative_idx
749  ENDDO !node_idx
750  CASE(field_grid_point_based_interpolation)
751  CALL flagerror("Not implemented.",err,error,*999)
752  CASE(field_gauss_point_based_interpolation)
753  CALL flagerror("Not implemented.",err,error,*999)
754  CASE(field_data_point_based_interpolation)
755  decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
756  DO datapointidx=1,decompositiondata%elementDataPoint(rowelementnumber)%numberOfProjectedData
757  localdatapointnumber=decompositiondata%elementDataPoint(rowelementnumber)% &
758  & dataindices(datapointidx)%localNumber
759  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
760  & data_points(localdatapointnumber)
761  global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
762  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
763  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
764  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
765  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
766  ENDDO
767  CASE DEFAULT
768  local_error="The interpolation type of "// &
769  & trim(numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,"*",err,error))// &
770  & " is invalid for component number "// &
771  & trim(numbertovstring(component_idx,"*",err,error))// &
772  & " of rows field variable type "// &
773  & trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))//"."
774  CALL flagerror(local_error,err,error,*999)
775  END SELECT
776  ELSE
777  local_error="Element number "//trim(numbertovstring(rowelementnumber,"*",err,error))// &
778  & " is invalid for component number "//trim(numbertovstring(component_idx,"*",err,error))// &
779  & " of rows field variable type "// &
780  & trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))// &
781  & ". The element number must be between 1 and "// &
782  & trim(numbertovstring(elements_topology%TOTAL_NUMBER_OF_ELEMENTS,"*",err,error))//"."
783  CALL flagerror(local_error,err,error,*999)
784  ENDIF
785  ENDDO !elementIdx
786  ENDDO !component_idx
787  ELSE
788  !Row and column variables are different
789  !Row mapping
790  DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
791  elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
792  DO elementidx=1,SIZE(row_element_numbers)
793  rowelementnumber=row_element_numbers(elementidx)
794  IF(rowelementnumber>=1.AND.rowelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS) THEN
795  SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
796  CASE(field_constant_interpolation)
797  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
798  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
799  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
800  CASE(field_element_based_interpolation)
801  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
802  & elements(rowelementnumber)
803  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
804  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
805  CASE(field_node_based_interpolation)
806  basis=>elements_topology%ELEMENTS(rowelementnumber)%BASIS
807  DO node_idx=1,basis%NUMBER_OF_NODES
808  node=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_NODES(node_idx)
809  DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
810  derivative=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
811  version=elements_topology%ELEMENTS(rowelementnumber)%elementVersions(derivative_idx,node_idx)
812  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
813  & derivatives(derivative)%VERSIONS(version)
814  element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
815  element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
816  ENDDO !derivative_idx
817  ENDDO !node_idx
818  CASE(field_grid_point_based_interpolation)
819  CALL flagerror("Not implemented.",err,error,*999)
820  CASE(field_gauss_point_based_interpolation)
821  CALL flagerror("Not implemented.",err,error,*999)
822  CASE(field_data_point_based_interpolation)
823  decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
824  DO datapointidx=1,decompositiondata%elementDataPoint(colelementnumber)%numberOfProjectedData
825  localdatapointnumber=decompositiondata%elementDataPoint(colelementnumber)% &
826  & dataindices(datapointidx)%localNumber
827  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
828  & data_points(localdatapointnumber)
829  global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
830  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
831  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
832  ENDDO
833  CASE DEFAULT
834  local_error="The interpolation type of "// &
835  & trim(numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,"*",err,error))// &
836  & " is invalid for component number "// &
837  & trim(numbertovstring(component_idx,"*",err,error))// &
838  & " of rows field variable type "// &
839  & trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))//"."
840  CALL flagerror(local_error,err,error,*999)
841  END SELECT
842  ELSE
843  local_error="Row element number "//trim(numbertovstring(rowelementnumber,"*",err,error))// &
844  & " is invalid for component number "//trim(numbertovstring(component_idx,"*",err,error))// &
845  & " of rows field variable type "// &
846  & trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))// &
847  & ". The element number must be between 1 and "// &
848  & trim(numbertovstring(elements_topology%TOTAL_NUMBER_OF_ELEMENTS,"*",err,error))//"."
849  CALL flagerror(local_error,err,error,*999)
850  ENDIF
851  ENDDO !elementIdx
852  ENDDO !component_idx
853  !Column mapping
854  DO component_idx=1,cols_field_variable%NUMBER_OF_COMPONENTS
855  elements_topology=>cols_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
856  DO elementidx=1,SIZE(column_element_numbers)
857  colelementnumber=column_element_numbers(elementidx)
858  IF(colelementnumber>=1.AND.colelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS) THEN
859  SELECT CASE(cols_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
860  CASE(field_constant_interpolation)
861  local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
862  global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
863  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
864  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
865  CASE(field_element_based_interpolation)
866  local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
867  & elements(colelementnumber)
868  global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
869  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
870  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
871  CASE(field_node_based_interpolation)
872  basis=>elements_topology%ELEMENTS(colelementnumber)%BASIS
873  DO node_idx=1,basis%NUMBER_OF_NODES
874  node=elements_topology%ELEMENTS(colelementnumber)%ELEMENT_NODES(node_idx)
875  DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
876  derivative=elements_topology%ELEMENTS(colelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
877  version=elements_topology%ELEMENTS(colelementnumber)%elementVersions(derivative_idx,node_idx)
878  local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
879  & derivatives(derivative)%VERSIONS(version)
880  global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
881  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
882  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
883  ENDDO !derivative_idx
884  ENDDO !node_idx
885  CASE(field_grid_point_based_interpolation)
886  CALL flagerror("Not implemented.",err,error,*999)
887  CASE(field_gauss_point_based_interpolation)
888  CALL flagerror("Not implemented.",err,error,*999)
889  CASE(field_data_point_based_interpolation)
890  decompositiondata=>cols_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
891  DO datapointidx=1,decompositiondata%elementDataPoint(colelementnumber)%numberOfProjectedData
892  localdatapointnumber=decompositiondata%elementDataPoint(colelementnumber)% &
893  & dataindices(datapointidx)%localNumber
894  local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
895  & data_points(localdatapointnumber)
896  global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
897  element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
898  element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
899  ENDDO
900  CASE DEFAULT
901  local_error="The interpolation type of "// &
902  & trim(numbertovstring(cols_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,"*",err,error))// &
903  & " is invalid for component number "// &
904  & trim(numbertovstring(component_idx,"*",err,error))// &
905  & " of column field variable type "// &
906  & trim(numbertovstring(cols_field_variable%VARIABLE_TYPE,"*",err,error))//"."
907  CALL flagerror(local_error,err,error,*999)
908  END SELECT
909  ELSE
910  local_error="Column element number "//trim(numbertovstring(colelementnumber,"*",err,error))// &
911  & " is invalid for component number "//trim(numbertovstring(component_idx,"*",err,error))// &
912  & " of column field variable type "// &
913  & trim(numbertovstring(cols_field_variable%VARIABLE_TYPE,"*",err,error))// &
914  & ". The element number must be between 1 and "// &
915  & trim(numbertovstring(elements_topology%TOTAL_NUMBER_OF_ELEMENTS,"*",err,error))//"."
916  CALL flagerror(local_error,err,error,*999)
917  ENDIF
918  ENDDO !elementIdx
919  ENDDO !component_idx
920  ENDIF
921  element_matrix%MATRIX=0.0_dp
922  ENDIF
923  ELSE
924  CALL flagerror("Columns field variable is not associated.",err,error,*999)
925  ENDIF
926  ELSE
927  CALL flagerror("Rows field variable is not associated.",err,error,*999)
928  ENDIF
929 
930  exits("EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE")
931  RETURN
932 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE",err,error)
933  RETURN 1
934 
935  END SUBROUTINE equations_matrices_element_matrix_calculate
936 
937  !
938  !================================================================================================================================
939  !
940 
942  SUBROUTINE equations_matrices_element_matrix_finalise(ELEMENT_MATRIX,ERR,ERROR,*)
943 
944  !Argument variables
945  TYPE(element_matrix_type):: ELEMENT_MATRIX
946  INTEGER(INTG), INTENT(OUT) :: ERR
947  TYPE(varying_string), INTENT(OUT) :: ERROR
948  !Local Variables
949 
950  enters("EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE",err,error,*999)
951 
952  element_matrix%MAX_NUMBER_OF_ROWS=0
953  element_matrix%MAX_NUMBER_OF_COLUMNS=0
954  IF(ALLOCATED(element_matrix%ROW_DOFS)) DEALLOCATE(element_matrix%ROW_DOFS)
955  IF(ALLOCATED(element_matrix%COLUMN_DOFS)) DEALLOCATE(element_matrix%COLUMN_DOFS)
956  IF(ALLOCATED(element_matrix%MATRIX)) DEALLOCATE(element_matrix%MATRIX)
957 
958  exits("EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE")
959  RETURN
960 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE",err,error)
961  RETURN 1
962  END SUBROUTINE equations_matrices_element_matrix_finalise
963 
964  !
965  !================================================================================================================================
966  !
967 
969  SUBROUTINE equationsmatrices_elementmatrixinitialise(ELEMENT_MATRIX,ERR,ERROR,*)
970 
971  !Argument variables
972  TYPE(element_matrix_type) :: ELEMENT_MATRIX !The element matrix to initialise
973  INTEGER(INTG), INTENT(OUT) :: ERR
974  TYPE(varying_string), INTENT(OUT) :: ERROR
975  !Local Variables
976 
977  enters("EquationsMatrices_ElementMatrixInitialise",err,error,*999)
978 
979  element_matrix%EQUATIONS_MATRIX_NUMBER=0
980  element_matrix%NUMBER_OF_ROWS=0
981  element_matrix%NUMBER_OF_COLUMNS=0
982  element_matrix%MAX_NUMBER_OF_ROWS=0
983  element_matrix%MAX_NUMBER_OF_COLUMNS=0
984 
985  exits("EquationsMatrices_ElementMatrixInitialise")
986  RETURN
987 999 errorsexits("EquationsMatrices_ElementMatrixInitialise",err,error)
988  RETURN 1
989  END SUBROUTINE equationsmatrices_elementmatrixinitialise
990 
991  !
992  !================================================================================================================================
993  !
994 
996  SUBROUTINE equations_matrices_element_matrix_setup(elementMatrix,rowsFieldVariable,columnsFieldVariable, &
997  & rowsnumberofelements,colsnumberofelements,err,error,*)
998 
999  !Argument variables
1000  TYPE(element_matrix_type) :: elementMatrix
1001  TYPE(field_variable_type), POINTER :: rowsFieldVariable
1002  TYPE(field_variable_type), POINTER :: columnsFieldVariable
1003  INTEGER(INTG), INTENT(IN) :: rowsNumberOfElements
1004  INTEGER(INTG), INTENT(IN) :: colsNumberOfElements
1005  INTEGER(INTG), INTENT(OUT) :: err
1006  TYPE(varying_string), INTENT(OUT) :: error
1007  !Local Variables
1008  INTEGER(INTG) :: dummyErr, componentIdx
1009  TYPE(varying_string) :: dummyError
1010 
1011  enters("EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP",err,error,*998)
1012 
1013  IF(ASSOCIATED(rowsfieldvariable)) THEN
1014  IF(ASSOCIATED(columnsfieldvariable)) THEN
1015  elementmatrix%MAX_NUMBER_OF_ROWS = 0
1016  DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1017  elementmatrix%MAX_NUMBER_OF_ROWS=elementmatrix%MAX_NUMBER_OF_ROWS+ &
1018  & rowsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1019  ENDDO
1020  elementmatrix%MAX_NUMBER_OF_ROWS=elementmatrix%MAX_NUMBER_OF_ROWS*rowsnumberofelements
1021  elementmatrix%MAX_NUMBER_OF_COLUMNS = 0
1022  DO componentidx=1,columnsfieldvariable%NUMBER_OF_COMPONENTS
1023  elementmatrix%MAX_NUMBER_OF_COLUMNS=elementmatrix%MAX_NUMBER_OF_COLUMNS+ &
1024  & columnsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1025  ENDDO
1026  elementmatrix%MAX_NUMBER_OF_COLUMNS=elementmatrix%MAX_NUMBER_OF_COLUMNS*colsnumberofelements
1027  IF(ALLOCATED(elementmatrix%ROW_DOFS)) THEN
1028  CALL flagerror("Element matrix row dofs already allocated.",err,error,*999)
1029  ELSE
1030  ALLOCATE(elementmatrix%ROW_DOFS(elementmatrix%MAX_NUMBER_OF_ROWS),stat=err)
1031  IF(err/=0) CALL flagerror("Could not allocate element matrix row dofs.",err,error,*999)
1032  ENDIF
1033  IF(ALLOCATED(elementmatrix%COLUMN_DOFS)) THEN
1034  CALL flagerror("Element matrix column dofs already allocated.",err,error,*999)
1035  ELSE
1036  ALLOCATE(elementmatrix%COLUMN_DOFS(elementmatrix%MAX_NUMBER_OF_COLUMNS),stat=err)
1037  IF(err/=0) CALL flagerror("Could not allocate element matrix column dofs.",err,error,*999)
1038  ENDIF
1039  IF(ALLOCATED(elementmatrix%MATRIX)) THEN
1040  CALL flagerror("Element matrix already allocated.",err,error,*999)
1041  ELSE
1042  ALLOCATE(elementmatrix%MATRIX(elementmatrix%MAX_NUMBER_OF_ROWS,elementmatrix%MAX_NUMBER_OF_COLUMNS),stat=err)
1043  IF(err/=0) CALL flagerror("Could not allocate element matrix.",err,error,*999)
1044  ENDIF
1045  ELSE
1046  CALL flagerror("Columns field variable is not associated.",err,error,*999)
1047  ENDIF
1048  ELSE
1049  CALL flagerror("Rows field variable is not associated.",err,error,*999)
1050  ENDIF
1051 
1052  exits("EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP")
1053  RETURN
1054 999 CALL equations_matrices_element_matrix_finalise(elementmatrix,dummyerr,dummyerror,*998)
1055 998 errorsexits("EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP",err,error)
1056  RETURN 1
1057  END SUBROUTINE equations_matrices_element_matrix_setup
1058 
1059  !
1060  !================================================================================================================================
1061  !
1062 
1064  SUBROUTINE equations_matrices_element_vector_calculate(ELEMENT_VECTOR,UPDATE_VECTOR,ELEMENT_NUMBER,ROWS_FIELD_VARIABLE, &
1065  & err,error,*)
1066 
1067  !Argument variables
1068  TYPE(element_vector_type) :: ELEMENT_VECTOR
1069  LOGICAL :: UPDATE_VECTOR
1070  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
1071  TYPE(field_variable_type), POINTER :: ROWS_FIELD_VARIABLE
1072  INTEGER(INTG), INTENT(OUT) :: ERR
1073  TYPE(varying_string), INTENT(OUT) :: ERROR
1074  !Local Variables
1075  INTEGER(INTG) :: component_idx,derivative,derivative_idx,local_ny,node,node_idx,version,dataPointIdx,localDataPointNumber
1076  TYPE(basis_type), POINTER :: BASIS
1077  TYPE(domain_elements_type), POINTER :: ELEMENTS_TOPOLOGY
1078  TYPE(decompositiondatapointstype), POINTER :: decompositionData
1079  TYPE(varying_string) :: LOCAL_ERROR
1080 
1081  enters("EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE",err,error,*999)
1082 
1083  IF(ASSOCIATED(rows_field_variable)) THEN
1084  !Calculate the rows for the element vector
1085  element_vector%NUMBER_OF_ROWS=0
1086  IF(update_vector) THEN
1087  DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
1088  elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
1089  IF(element_number>=1.AND.element_number<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS) THEN
1090  SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
1091  CASE(field_constant_interpolation)
1092  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1093  element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1094  element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1095  CASE(field_element_based_interpolation)
1096  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1097  & elements(element_number)
1098  element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1099  element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1100  CASE(field_node_based_interpolation)
1101  basis=>elements_topology%ELEMENTS(element_number)%BASIS
1102  DO node_idx=1,basis%NUMBER_OF_NODES
1103  node=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(node_idx)
1104  DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
1105  derivative=elements_topology%ELEMENTS(element_number)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
1106  version=elements_topology%ELEMENTS(element_number)%elementVersions(derivative_idx,node_idx)
1107  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
1108  & derivatives(derivative)%VERSIONS(version)
1109  element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1110  element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1111  ENDDO !derivative_idx
1112  ENDDO !node_idx
1113  CASE(field_grid_point_based_interpolation)
1114  CALL flagerror("Not implemented.",err,error,*999)
1115  CASE(field_gauss_point_based_interpolation)
1116  CALL flagerror("Not implemented.",err,error,*999)
1117  CASE(field_data_point_based_interpolation)
1118  decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
1119  DO datapointidx=1,decompositiondata%elementDataPoint(element_number)%numberOfProjectedData
1120  localdatapointnumber=decompositiondata%elementDataPoint(element_number)% &
1121  & dataindices(datapointidx)%localNumber
1122  local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
1123  & data_points(localdatapointnumber)
1124  element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1125  element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1126  ENDDO
1127  CASE DEFAULT
1128  local_error="The interpolation type of "// &
1129  & trim(numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,"*",err,error))// &
1130  & " is invalid for component number "// &
1131  & trim(numbertovstring(component_idx,"*",err,error))// &
1132  & " of rows field variable type "// &
1133  & trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))//"."
1134  CALL flagerror(local_error,err,error,*999)
1135  END SELECT
1136  ELSE
1137  local_error="Element number "//trim(numbertovstring(element_number,"*",err,error))// &
1138  & " is invalid for component number "//trim(numbertovstring(component_idx,"*",err,error))// &
1139  & " of rows field variable type "//trim(numbertovstring(rows_field_variable%VARIABLE_TYPE,"*",err,error))// &
1140  & ". The element number must be between 1 and "// &
1141  & trim(numbertovstring(elements_topology%TOTAL_NUMBER_OF_ELEMENTS,"*",err,error))//"."
1142  CALL flagerror(local_error,err,error,*999)
1143  ENDIF
1144  ENDDO !component_idx
1145  element_vector%VECTOR=0.0_dp
1146  ENDIF
1147  ELSE
1148  CALL flagerror("Rows field variable is not associated.",err,error,*999)
1149  ENDIF
1150 
1151  exits("EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE")
1152  RETURN
1153 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE",err,error)
1154  RETURN 1
1155 
1156  END SUBROUTINE equations_matrices_element_vector_calculate
1157 
1158  !
1159  !================================================================================================================================
1160  !
1161 
1163  SUBROUTINE equations_matrices_element_vector_finalise(ELEMENT_VECTOR,ERR,ERROR,*)
1164 
1165  !Argument variables
1166  TYPE(element_vector_type):: ELEMENT_VECTOR
1167  INTEGER(INTG), INTENT(OUT) :: ERR
1168  TYPE(varying_string), INTENT(OUT) :: ERROR
1169  !Local Variables
1170 
1171  enters("EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE",err,error,*999)
1172 
1173  IF(ALLOCATED(element_vector%ROW_DOFS)) DEALLOCATE(element_vector%ROW_DOFS)
1174  IF(ALLOCATED(element_vector%VECTOR)) DEALLOCATE(element_vector%VECTOR)
1175 
1176  exits("EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE")
1177  RETURN
1178 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE",err,error)
1179 
1180  RETURN 1
1181  END SUBROUTINE equations_matrices_element_vector_finalise
1182 
1183  !
1184  !================================================================================================================================
1185  !
1186 
1188  SUBROUTINE equationsmatrices_elementvectorinitialise(ELEMENT_VECTOR,ERR,ERROR,*)
1189 
1190  !Argument variables
1191  TYPE(element_vector_type) :: ELEMENT_VECTOR !The element vector to initialise
1192  INTEGER(INTG), INTENT(OUT) :: ERR
1193  TYPE(varying_string), INTENT(OUT) :: ERROR
1194  !Local Variables
1195 
1196  enters("EquationsMatrices_ElementVectorInitialise",err,error,*999)
1197 
1198  element_vector%NUMBER_OF_ROWS=0
1199  element_vector%MAX_NUMBER_OF_ROWS=0
1200 
1201  exits("EquationsMatrices_ElementVectorInitialise")
1202  RETURN
1203 999 errorsexits("EquationsMatrices_ElementVectorInitialise",err,error)
1204  RETURN 1
1205  END SUBROUTINE equationsmatrices_elementvectorinitialise
1206 
1207  !
1208  !================================================================================================================================
1209  !
1210 
1212  SUBROUTINE equations_matrices_element_vector_setup(elementVector,rowsFieldVariable,err,error,*)
1213 
1214  !Argument variables
1215  TYPE(element_vector_type) :: elementVector
1216  TYPE(field_variable_type), POINTER :: rowsFieldVariable
1217  INTEGER(INTG), INTENT(OUT) :: err
1218  TYPE(varying_string), INTENT(OUT) :: error
1219  !Local Variables
1220  INTEGER(INTG) :: DUMMY_ERR,componentIdx
1221  TYPE(varying_string) :: dummyError
1222 
1223  enters("EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP",err,error,*998)
1224 
1225  IF(ASSOCIATED(rowsfieldvariable)) THEN
1226  elementvector%MAX_NUMBER_OF_ROWS = 0
1227  DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1228  elementvector%MAX_NUMBER_OF_ROWS=elementvector%MAX_NUMBER_OF_ROWS+ &
1229  & rowsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1230  ENDDO
1231  IF(ALLOCATED(elementvector%ROW_DOFS)) THEN
1232  CALL flagerror("Element vector row dofs is already allocated.",err,error,*999)
1233  ELSE
1234  ALLOCATE(elementvector%ROW_DOFS(elementvector%MAX_NUMBER_OF_ROWS),stat=err)
1235  IF(err/=0) CALL flagerror("Could not allocate element vector row dofs.",err,error,*999)
1236  ENDIF
1237  IF(ALLOCATED(elementvector%VECTOR)) THEN
1238  CALL flagerror("Element vector vector already allocated.",err,error,*999)
1239  ELSE
1240  ALLOCATE(elementvector%VECTOR(elementvector%MAX_NUMBER_OF_ROWS),stat=err)
1241  IF(err/=0) CALL flagerror("Could not allocate element vector vector.",err,error,*999)
1242  ENDIF
1243  ELSE
1244  CALL flagerror("Rows field variable is not associated.",err,error,*999)
1245  ENDIF
1246 
1247  exits("EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP")
1248  RETURN
1249 999 CALL equations_matrices_element_vector_finalise(elementvector,dummy_err,dummyerror,*998)
1250 998 errorsexits("EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP",err,error)
1251  RETURN 1
1252  END SUBROUTINE equations_matrices_element_vector_setup
1253 
1254  !
1255  !================================================================================================================================
1256  !
1257 
1259  SUBROUTINE equations_matrices_element_add(EQUATIONS_MATRICES,ERR,ERROR,*)
1260 
1261  !Argument variables
1262  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1263  INTEGER(INTG), INTENT(OUT) :: ERR
1264  TYPE(varying_string), INTENT(OUT) :: ERROR
1265  !Local Variables
1266  INTEGER(INTG) :: column_idx,matrix_idx,row_idx
1267  REAL(DP) :: SUM
1268  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1269  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
1270  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
1271  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
1272  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
1273  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
1274  TYPE(varying_string) :: LOCAL_ERROR
1275 
1276 #ifdef TAUPROF
1277  CALL tau_static_phase_start("EQUATIONS_MATRICES_ELEMENT_ADD()")
1278 #endif
1279 
1280  enters("EQUATIONS_MATRICES_ELEMENT_ADD",err,error,*999)
1281 
1282  IF(ASSOCIATED(equations_matrices)) THEN
1283  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1284  IF(ASSOCIATED(dynamic_matrices)) THEN
1285  !Add the element matrices
1286  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
1287  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
1288  IF(ASSOCIATED(equations_matrix)) THEN
1289  IF(equations_matrix%UPDATE_MATRIX) THEN
1290  !Handle lumped matrices
1291  IF(equations_matrix%LUMPED) THEN
1292  DO row_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS
1293  sum=0.0_dp
1294  DO column_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS
1295  sum=sum+equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)
1296  equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)=0.0_dp
1297  ENDDO !column_idx
1298  equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,row_idx)=sum
1299  !Add the element matrice into the distributed equations matrix
1300  CALL distributed_matrix_values_add(equations_matrix%MATRIX,equations_matrix%ELEMENT_MATRIX%ROW_DOFS(row_idx), &
1301  & equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(row_idx),equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx, &
1302  & row_idx),err,error,*999)
1303  ENDDO !row_idx
1304  ELSE
1305  !Add the element matrice into the distributed equations matrix
1306  CALL distributed_matrix_values_add(equations_matrix%MATRIX,equations_matrix%ELEMENT_MATRIX%ROW_DOFS(1: &
1307  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
1308  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),equations_matrix%ELEMENT_MATRIX%MATRIX(1: &
1309  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS), &
1310  & err,error,*999)
1311  ENDIF
1312  ENDIF
1313  ELSE
1314  local_error="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
1315  & " is not associated."
1316  CALL flagerror(local_error,err,error,*999)
1317  ENDIF
1318  ENDDO !matrix_idx
1319  ENDIF
1320  linear_matrices=>equations_matrices%LINEAR_MATRICES
1321  IF(ASSOCIATED(linear_matrices)) THEN
1322  !Add the element matrices
1323  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1324  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
1325  IF(ASSOCIATED(equations_matrix)) THEN
1326  IF(equations_matrix%UPDATE_MATRIX) THEN
1327  !Handle lumped matrices
1328  IF(equations_matrix%LUMPED) THEN
1329  DO row_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS
1330  sum=0.0_dp
1331  DO column_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS
1332  sum=sum+equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)
1333  equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)=0.0_dp
1334  ENDDO !column_idx
1335  equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,row_idx)=sum
1336  !Add the element matrice into the distributed equations matrix
1337  CALL distributed_matrix_values_add(equations_matrix%MATRIX,equations_matrix%ELEMENT_MATRIX%ROW_DOFS(row_idx), &
1338  & equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(row_idx),equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx, &
1339  & row_idx),err,error,*999)
1340  ENDDO !row_idx
1341  ELSE
1342  !Add the element matrice into the distributed equations matrix
1343  CALL distributed_matrix_values_add(equations_matrix%MATRIX,equations_matrix%ELEMENT_MATRIX%ROW_DOFS(1: &
1344  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
1345  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),equations_matrix%ELEMENT_MATRIX%MATRIX(1: &
1346  & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS), &
1347  & err,error,*999)
1348  ENDIF
1349  ENDIF
1350  ELSE
1351  local_error="Equations matrix for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
1352  & " is not associated."
1353  CALL flagerror(local_error,err,error,*999)
1354  ENDIF
1355  ENDDO !matrix_idx
1356  ENDIF
1357  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
1358  IF(ASSOCIATED(nonlinear_matrices)) THEN
1359  IF(nonlinear_matrices%UPDATE_RESIDUAL) THEN
1360  !Add the residual element vector
1361  CALL distributed_vector_values_add(nonlinear_matrices%RESIDUAL,nonlinear_matrices%ELEMENT_RESIDUAL%ROW_DOFS(1: &
1362  & nonlinear_matrices%ELEMENT_RESIDUAL%NUMBER_OF_ROWS),nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(1:nonlinear_matrices% &
1363  & element_residual%NUMBER_OF_ROWS),err,error,*999)
1364  ENDIF
1365  ENDIF
1366  rhs_vector=>equations_matrices%RHS_VECTOR
1367  IF(ASSOCIATED(rhs_vector)) THEN
1368  IF(rhs_vector%UPDATE_VECTOR) THEN
1369  !Add the rhs element vector
1370  CALL distributed_vector_values_add(rhs_vector%VECTOR,rhs_vector%ELEMENT_VECTOR%ROW_DOFS(1: &
1371  & rhs_vector%ELEMENT_VECTOR%NUMBER_OF_ROWS),rhs_vector%ELEMENT_VECTOR%VECTOR(1:rhs_vector% &
1372  & element_vector%NUMBER_OF_ROWS),err,error,*999)
1373  ENDIF
1374  ENDIF
1375  source_vector=>equations_matrices%SOURCE_VECTOR
1376  IF(ASSOCIATED(source_vector)) THEN
1377  IF(source_vector%UPDATE_VECTOR) THEN
1378  !Add the rhs element vector
1379  CALL distributed_vector_values_add(source_vector%VECTOR,source_vector%ELEMENT_VECTOR%ROW_DOFS(1: &
1380  & source_vector%ELEMENT_VECTOR%NUMBER_OF_ROWS),source_vector%ELEMENT_VECTOR%VECTOR(1:source_vector% &
1381  & element_vector%NUMBER_OF_ROWS),err,error,*999)
1382  ENDIF
1383  ENDIF
1384  ELSE
1385  CALL flagerror("Equations matrices is not allocated.",err,error,*999)
1386  ENDIF
1387 #ifdef TAUPROF
1388  CALL tau_static_phase_stop("EQUATIONS_MATRICES_ELEMENT_ADD()")
1389 #endif
1390 
1391  exits("EQUATIONS_MATRICES_ELEMENT_ADD")
1392  RETURN
1393 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_ADD",err,error)
1394  RETURN 1
1395  END SUBROUTINE equations_matrices_element_add
1396 
1397  !
1398  !================================================================================================================================
1399  !
1400 
1402  SUBROUTINE equations_matrices_element_calculate(EQUATIONS_MATRICES,ELEMENT_NUMBER,ERR,ERROR,*)
1403 
1404  !Argument variables
1405  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1406  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
1407  INTEGER(INTG), INTENT(OUT) :: ERR
1408  TYPE(varying_string), INTENT(OUT) :: ERROR
1409  !Local Variables
1410  INTEGER(INTG) :: matrix_idx
1411  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
1412  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1413  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
1414  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
1415  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
1416  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
1417  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1418  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
1419  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
1420  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
1421  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
1422  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
1423  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,COL_FIELD_VARIABLE
1424  TYPE(varying_string) :: LOCAL_ERROR
1425 
1426 #ifdef TAUPROF
1427  CALL tau_static_phase_start("EQUATIONS_MATRICES_ELEMENT_CALCULATE()")
1428 #endif
1429 
1430  enters("EQUATIONS_MATRICES_ELEMENT_CALCULATE",err,error,*999)
1431 
1432  IF(ASSOCIATED(equations_matrices)) THEN
1433  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
1434  IF(ASSOCIATED(equations_mapping)) THEN
1435  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1436  IF(ASSOCIATED(dynamic_matrices)) THEN
1437  !Calculate the row and columns for the dynamic equations matrices
1438  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
1439  IF(ASSOCIATED(dynamic_mapping)) THEN
1440  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
1441  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
1442  IF(ASSOCIATED(equations_matrix)) THEN
1443  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
1444  CALL equations_matrices_element_matrix_calculate(equations_matrix%ELEMENT_MATRIX,equations_matrix%UPDATE_MATRIX, &
1445  & [element_number],[element_number],field_variable,field_variable,err,error,*999)
1446  ELSE
1447  local_error="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
1448  & " is not associated."
1449  CALL flagerror(local_error,err,error,*999)
1450  ENDIF
1451  ENDDO !matrix_idx
1452  ELSE
1453  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
1454  ENDIF
1455  ENDIF
1456  linear_matrices=>equations_matrices%LINEAR_MATRICES
1457  IF(ASSOCIATED(linear_matrices)) THEN
1458  !Calculate the row and columns for the linear equations matrices
1459  linear_mapping=>equations_mapping%LINEAR_MAPPING
1460  IF(ASSOCIATED(linear_mapping)) THEN
1461  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1462  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
1463  IF(ASSOCIATED(equations_matrix)) THEN
1464  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
1465  CALL equations_matrices_element_matrix_calculate(equations_matrix%ELEMENT_MATRIX,equations_matrix%UPDATE_MATRIX, &
1466  & [element_number],[element_number],field_variable,field_variable,err,error,*999)
1467  ELSE
1468  local_error="Equations matrix for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
1469  & " is not associated."
1470  CALL flagerror(local_error,err,error,*999)
1471  ENDIF
1472  ENDDO !matrix_idx
1473  ELSE
1474  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
1475  ENDIF
1476  ENDIF
1477  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
1478  IF(ASSOCIATED(nonlinear_matrices)) THEN
1479  !Calculate the rows and columns of the Jacobian
1480  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
1481  IF(ASSOCIATED(nonlinear_mapping)) THEN
1482  field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE !Row field variable
1483  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
1484  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
1485  IF(ASSOCIATED(jacobian_matrix)) THEN
1486  col_field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE
1487  CALL equations_matrices_element_matrix_calculate(jacobian_matrix%ELEMENT_JACOBIAN,jacobian_matrix%UPDATE_JACOBIAN, &
1488  & [element_number],[element_number],field_variable,col_field_variable,err,error,*999)
1489  ELSE
1490  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
1491  ENDIF
1492  ENDDO
1493  !Calculate the rows of the equations residual
1494  rhs_mapping=>equations_mapping%RHS_MAPPING
1495  IF(ASSOCIATED(rhs_mapping)) THEN
1496  field_variable=>rhs_mapping%RHS_VARIABLE
1497  ELSE
1498  field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1499  ENDIF
1500  CALL equations_matrices_element_vector_calculate(nonlinear_matrices%ELEMENT_RESIDUAL,nonlinear_matrices% &
1501  & update_residual,element_number,field_variable,err,error,*999)
1502  nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=0
1503  ELSE
1504  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
1505  ENDIF
1506  ENDIF
1507  rhs_vector=>equations_matrices%RHS_VECTOR
1508  IF(ASSOCIATED(rhs_vector)) THEN
1509  rhs_mapping=>equations_mapping%RHS_MAPPING
1510  IF(ASSOCIATED(rhs_mapping)) THEN
1511  !Calculate the rows for the equations RHS
1512  field_variable=>rhs_mapping%RHS_VARIABLE
1513  CALL equations_matrices_element_vector_calculate(rhs_vector%ELEMENT_VECTOR,rhs_vector%UPDATE_VECTOR,element_number, &
1514  & field_variable,err,error,*999)
1515  ELSE
1516  CALL flagerror("Equations mapping rhs mapping is not associated.",err,error,*999)
1517  ENDIF
1518  ENDIF
1519  source_vector=>equations_matrices%SOURCE_VECTOR
1520  IF(ASSOCIATED(source_vector)) THEN
1521  !Calculate the rows the equations source. The number of rows is not set by the source field so take the number of rows
1522  !from the RHS vector in the first instance.
1523  rhs_mapping=>equations_mapping%RHS_MAPPING
1524  IF(ASSOCIATED(rhs_mapping)) THEN
1525  field_variable=>rhs_mapping%RHS_VARIABLE
1526  CALL equations_matrices_element_vector_calculate(source_vector%ELEMENT_VECTOR,source_vector%UPDATE_VECTOR, &
1527  & element_number,field_variable,err,error,*999)
1528  ELSE
1529  CALL flagerror("Equations mapping rhs mapping is not associated.",err,error,*999)
1530  ENDIF
1531  ENDIF
1532  ELSE
1533  CALL flagerror("Equations mapping is not associated.",err,error,*999)
1534  ENDIF
1535  ELSE
1536  CALL flagerror("Equations matrices is not allocated",err,error,*999)
1537  ENDIF
1538 
1539 #ifdef TAUPROF
1540  CALL tau_static_phase_stop("EQUATIONS_MATRICES_ELEMENT_CALCULATE()")
1541 #endif
1542 
1543  exits("EQUATIONS_MATRICES_ELEMENT_CALCULATE")
1544  RETURN
1545 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_CALCULATE",err,error)
1546  RETURN 1
1547  END SUBROUTINE equations_matrices_element_calculate
1548 
1549  !
1550  !================================================================================================================================
1551  !
1552 
1554  SUBROUTINE equationsmatrices_nodalcalculate(equationsMatrices,nodeNumber,err,error,*)
1555 
1556  !Argument variables
1557  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1558  INTEGER(INTG), INTENT(IN) :: nodeNumber
1559  INTEGER(INTG), INTENT(OUT) :: err
1560  TYPE(varying_string), INTENT(OUT) :: error
1561  !Local Variables
1562  INTEGER(INTG) :: matrixIdx
1563  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
1564  TYPE(equations_mapping_type), POINTER :: equationsMapping
1565  TYPE(equations_mapping_dynamic_type), POINTER :: dynamicMapping
1566  TYPE(equations_mapping_linear_type), POINTER :: linearMapping
1567  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
1568  TYPE(equations_mapping_rhs_type), POINTER :: rhsMapping
1569  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
1570  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
1571  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
1572  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
1573  TYPE(equations_matrices_source_type), POINTER :: sourceVector
1574  TYPE(equations_matrix_type), POINTER :: equationsMatrix
1575  TYPE(field_variable_type), POINTER :: fieldVariable,columnFieldVariable
1576  TYPE(varying_string) :: localError
1577 
1578 #ifdef TAUPROF
1579  CALL tau_static_phase_start("EquationsMatrices_NodalCalculate()")
1580 #endif
1581 
1582  enters("EquationsMatrices_NodalCalculate",err,error,*999)
1583 
1584  IF(ASSOCIATED(equationsmatrices)) THEN
1585  equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
1586  IF(ASSOCIATED(equationsmapping)) THEN
1587  dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
1588  IF(ASSOCIATED(dynamicmatrices)) THEN
1589  !Calculate the row and columns for the dynamic equations matrices
1590  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
1591  IF(ASSOCIATED(dynamicmapping)) THEN
1592  DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
1593  equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
1594  IF(ASSOCIATED(equationsmatrix)) THEN
1595  fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
1596  CALL equationsmatrices_nodalmatrixcalculate(equationsmatrix%NodalMatrix,equationsmatrix%UPDATE_MATRIX, &
1597  & nodenumber,nodenumber,fieldvariable,fieldvariable,err,error,*999)
1598  ELSE
1599  localerror="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
1600  & " is not associated."
1601  CALL flagerror(localerror,err,error,*999)
1602  ENDIF
1603  ENDDO !matrixIdx
1604  ELSE
1605  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
1606  ENDIF
1607  ENDIF
1608  linearmatrices=>equationsmatrices%LINEAR_MATRICES
1609  IF(ASSOCIATED(linearmatrices)) THEN
1610  !Calculate the row and columns for the linear equations matrices
1611  linearmapping=>equationsmapping%LINEAR_MAPPING
1612  IF(ASSOCIATED(linearmapping)) THEN
1613  DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
1614  equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
1615  IF(ASSOCIATED(equationsmatrix)) THEN
1616  fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
1617  CALL equationsmatrices_nodalmatrixcalculate(equationsmatrix%NodalMatrix,equationsmatrix%UPDATE_MATRIX, &
1618  & nodenumber,nodenumber,fieldvariable,fieldvariable,err,error,*999)
1619  ELSE
1620  localerror="Equations matrix for linear matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
1621  & " is not associated."
1622  CALL flagerror(localerror,err,error,*999)
1623  ENDIF
1624  ENDDO !matrixIdx
1625  ELSE
1626  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
1627  ENDIF
1628  ENDIF
1629  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
1630  IF(ASSOCIATED(nonlinearmatrices)) THEN
1631  !Calculate the rows and columns of the Jacobian
1632  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
1633  IF(ASSOCIATED(nonlinearmapping)) THEN
1634  fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE !Row field variable
1635  DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
1636  jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
1637  IF(ASSOCIATED(jacobianmatrix)) THEN
1638  columnfieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixidx)%VARIABLE
1639  CALL equationsmatrices_nodalmatrixcalculate(jacobianmatrix%NodalJacobian,jacobianmatrix%UPDATE_JACOBIAN, &
1640  & nodenumber,nodenumber,fieldvariable,columnfieldvariable,err,error,*999)
1641  ELSE
1642  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
1643  ENDIF
1644  ENDDO
1645  !Calculate the rows of the equations residual
1646  rhsmapping=>equationsmapping%RHS_MAPPING
1647  IF(ASSOCIATED(rhsmapping)) THEN
1648  fieldvariable=>rhsmapping%RHS_VARIABLE
1649  ELSE
1650  fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1651  ENDIF
1652  CALL equationsmatrices_nodalvectorcalculate(nonlinearmatrices%NodalResidual,nonlinearmatrices% &
1653  & update_residual,nodenumber,fieldvariable,err,error,*999)
1654  nonlinearmatrices%NodalResidualCalculated=0
1655  ELSE
1656  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
1657  ENDIF
1658  ENDIF
1659  rhsvector=>equationsmatrices%RHS_VECTOR
1660  IF(ASSOCIATED(rhsvector)) THEN
1661  rhsmapping=>equationsmapping%RHS_MAPPING
1662  IF(ASSOCIATED(rhsmapping)) THEN
1663  !Calculate the rows for the equations RHS
1664  fieldvariable=>rhsmapping%RHS_VARIABLE
1665  CALL equationsmatrices_nodalvectorcalculate(rhsvector%NodalVector,rhsvector%UPDATE_VECTOR,nodenumber, &
1666  & fieldvariable,err,error,*999)
1667  ELSE
1668  CALL flagerror("Equations mapping rhs mapping is not associated.",err,error,*999)
1669  ENDIF
1670  ENDIF
1671  sourcevector=>equationsmatrices%SOURCE_VECTOR
1672  IF(ASSOCIATED(sourcevector)) THEN
1673  !Calculate the rows the equations source. The number of rows is not set by the source field so take the number of rows
1674  !from the RHS vector in the first instance.
1675  rhsmapping=>equationsmapping%RHS_MAPPING
1676  IF(ASSOCIATED(rhsmapping)) THEN
1677  fieldvariable=>rhsmapping%RHS_VARIABLE
1678  CALL equationsmatrices_nodalvectorcalculate(sourcevector%NodalVector,sourcevector%UPDATE_VECTOR, &
1679  & nodenumber,fieldvariable,err,error,*999)
1680  ELSE
1681  CALL flagerror("Equations mapping rhs mapping is not associated.",err,error,*999)
1682  ENDIF
1683  ENDIF
1684  ELSE
1685  CALL flagerror("Equations mapping is not associated.",err,error,*999)
1686  ENDIF
1687  ELSE
1688  CALL flagerror("Equations matrices is not allocated",err,error,*999)
1689  ENDIF
1690 
1691 #ifdef TAUPROF
1692  CALL tau_static_phase_stop("EquationsMatrices_NodalCalculate()")
1693 #endif
1694 
1695  exits("EquationsMatrices_NodalCalculate")
1696  RETURN
1697 999 errorsexits("EquationsMatrices_NodalCalculate",err,error)
1698  RETURN 1
1699  END SUBROUTINE equationsmatrices_nodalcalculate
1700 
1701  !
1702  !================================================================================================================================
1703  !
1704 
1706  SUBROUTINE equationsmatrices_nodalmatrixcalculate(nodalMatrix,updateMatrix,rowNodeNumber,columnNodeNumber, &
1707  & rowsfieldvariable,colsfieldvariable,err,error,*)
1708 
1709  !Argument variables
1710  TYPE(nodalmatrixtype) :: nodalMatrix
1711  LOGICAL :: updateMatrix
1712  INTEGER(INTG), INTENT(IN) :: rowNodeNumber
1713  INTEGER(INTG), INTENT(IN) :: columnNodeNumber
1714  TYPE(field_variable_type), POINTER :: rowsFieldVariable
1715  TYPE(field_variable_type), POINTER :: colsFieldVariable
1716  INTEGER(INTG), INTENT(OUT) :: err
1717  TYPE(varying_string), INTENT(OUT) :: error
1718  !Local Variables
1719  INTEGER(INTG) :: componentIdx
1720  INTEGER(INTG) :: localRow,globalRow,localColumn,globalColumn
1721  INTEGER(INTG) :: numberOfDerivatives,numberOfVersions,versionIdx,derivativeIdx
1722  TYPE(domain_nodes_type), POINTER :: nodesTopology
1723  TYPE(varying_string) :: localError
1724 
1725  enters("EquationsMatrices_NodalMatrixCalculate",err,error,*999)
1726 
1727  IF(ASSOCIATED(rowsfieldvariable)) THEN
1728  IF(ASSOCIATED(colsfieldvariable)) THEN
1729  nodalmatrix%numberOfRows=0
1730  nodalmatrix%numberOfColumns=0
1731  IF(updatematrix) THEN
1732  IF(ASSOCIATED(rowsfieldvariable,colsfieldvariable)) THEN
1733  !Row and columns variable is the same.
1734  DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1735  nodestopology=>rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1736  IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES) THEN
1737  SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1738  CASE(field_constant_interpolation)
1739  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1740  globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1741  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1742  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1743  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1744  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1745  CASE(field_element_based_interpolation)
1746  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1747  & elements(rownodenumber)
1748  globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1749  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1750  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1751  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1752  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1753  CASE(field_node_based_interpolation)
1754  numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1755  & number_of_derivatives
1756  DO derivativeidx=1,numberofderivatives
1757  numberofversions=rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1758  & derivatives(derivativeidx)%numberOfVersions
1759  DO versionidx=1,numberofversions
1760  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1761  & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1762  globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1763  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1764  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1765  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1766  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1767  ENDDO !versionIdx
1768  ENDDO !derivativeIdx
1769  CASE(field_grid_point_based_interpolation)
1770  CALL flagerror("Not implemented.",err,error,*999)
1771  CASE(field_gauss_point_based_interpolation)
1772  CALL flagerror("Not implemented.",err,error,*999)
1773  CASE DEFAULT
1774  localerror="The interpolation type of "// &
1775  & trim(numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,"*",err,error))// &
1776  & " is invalid for component number "// &
1777  & trim(numbertovstring(componentidx,"*",err,error))// &
1778  & " of rows field variable type "// &
1779  & trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))//"."
1780  CALL flagerror(localerror,err,error,*999)
1781  END SELECT
1782  ELSE
1783  localerror="Nodal number "//trim(numbertovstring(rownodenumber,"*",err,error))// &
1784  & " is invalid for component number "//trim(numbertovstring(componentidx,"*",err,error))// &
1785  & " of rows field variable type "// &
1786  & trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))// &
1787  & ". The nodal number must be between 1 and "// &
1788  & trim(numbertovstring(nodestopology%TOTAL_NUMBER_OF_NODES,"*",err,error))//"."
1789  CALL flagerror(localerror,err,error,*999)
1790  ENDIF
1791  ENDDO !componentIdx
1792  ELSE
1793  !Row and column variables are different
1794  !Row mapping
1795  DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1796  nodestopology=>rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1797  IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES) THEN
1798  SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1799  CASE(field_constant_interpolation)
1800  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1801  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1802  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1803  CASE(field_element_based_interpolation)
1804  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1805  & elements(rownodenumber)
1806  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1807  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1808  CASE(field_node_based_interpolation)
1809  numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1810  & number_of_derivatives
1811  DO derivativeidx=1,numberofderivatives
1812  numberofversions=colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1813  & derivatives(derivativeidx)%numberOfVersions
1814  DO versionidx=1,numberofversions
1815  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1816  & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1817  nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1818  nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1819  ENDDO !versionIdx
1820  ENDDO !derivativeIdx
1821  CASE(field_grid_point_based_interpolation)
1822  CALL flagerror("Not implemented.",err,error,*999)
1823  CASE(field_gauss_point_based_interpolation)
1824  CALL flagerror("Not implemented.",err,error,*999)
1825  CASE DEFAULT
1826  localerror="The interpolation type of "// &
1827  & trim(numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,"*",err,error))// &
1828  & " is invalid for component number "// &
1829  & trim(numbertovstring(componentidx,"*",err,error))// &
1830  & " of rows field variable type "// &
1831  & trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))//"."
1832  CALL flagerror(localerror,err,error,*999)
1833  END SELECT
1834  ELSE
1835  localerror="Row nodal number "//trim(numbertovstring(rownodenumber,"*",err,error))// &
1836  & " is invalid for component number "//trim(numbertovstring(componentidx,"*",err,error))// &
1837  & " of rows field variable type "// &
1838  & trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))// &
1839  & ". The nodal number must be between 1 and "// &
1840  & trim(numbertovstring(nodestopology%TOTAL_NUMBER_OF_NODES,"*",err,error))//"."
1841  CALL flagerror(localerror,err,error,*999)
1842  ENDIF
1843  ENDDO !componentIdx
1844  !Column mapping
1845  DO componentidx=1,colsfieldvariable%NUMBER_OF_COMPONENTS
1846  nodestopology=>colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1847  IF(columnnodenumber>=1.AND.columnnodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES) THEN
1848  SELECT CASE(colsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1849  CASE(field_constant_interpolation)
1850  localcolumn=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1851  globalcolumn=colsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
1852  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1853  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalcolumn
1854  CASE(field_element_based_interpolation)
1855  localcolumn=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1856  & elements(columnnodenumber)
1857  globalcolumn=colsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
1858  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1859  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalcolumn
1860  CASE(field_node_based_interpolation)
1861  numberofderivatives=colsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1862  & number_of_derivatives
1863  DO derivativeidx=1,numberofderivatives
1864  numberofversions=colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1865  & derivatives(derivativeidx)%numberOfVersions
1866  DO versionidx=1,numberofversions
1867  localrow=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1868  & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1869  nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1870  nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=localrow
1871  ENDDO !versionIdx
1872  ENDDO !derivativeIdx
1873  CASE(field_grid_point_based_interpolation)
1874  CALL flagerror("Not implemented.",err,error,*999)
1875  CASE(field_gauss_point_based_interpolation)
1876  CALL flagerror("Not implemented.",err,error,*999)
1877  CASE DEFAULT
1878  localerror="The interpolation type of "// &
1879  & trim(numbertovstring(colsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,"*",err,error))// &
1880  & " is invalid for component number "// &
1881  & trim(numbertovstring(componentidx,"*",err,error))// &
1882  & " of column field variable type "// &
1883  & trim(numbertovstring(colsfieldvariable%VARIABLE_TYPE,"*",err,error))//"."
1884  CALL flagerror(localerror,err,error,*999)
1885  END SELECT
1886  ELSE
1887  localerror="Column nodal number "//trim(numbertovstring(columnnodenumber,"*",err,error))// &
1888  & " is invalid for component number "//trim(numbertovstring(componentidx,"*",err,error))// &
1889  & " of column field variable type "// &
1890  & trim(numbertovstring(colsfieldvariable%VARIABLE_TYPE,"*",err,error))// &
1891  & ". The nodal number must be between 1 and "// &
1892  & trim(numbertovstring(nodestopology%TOTAL_NUMBER_OF_NODES,"*",err,error))//"."
1893  CALL flagerror(localerror,err,error,*999)
1894  ENDIF
1895  ENDDO !componentIdx
1896  ENDIF
1897  nodalmatrix%matrix=0.0_dp
1898  ENDIF
1899  ELSE
1900  CALL flagerror("Columns field variable is not associated.",err,error,*999)
1901  ENDIF
1902  ELSE
1903  CALL flagerror("Rows field variable is not associated.",err,error,*999)
1904  ENDIF
1905 
1906  exits("EquationsMatrices_NodalMatrixCalculate")
1907  RETURN
1908 999 errorsexits("EquationsMatrices_NodalMatrixCalculate",err,error)
1909  RETURN 1
1910 
1911  END SUBROUTINE equationsmatrices_nodalmatrixcalculate
1912 
1913  !
1914  !================================================================================================================================
1915  !
1916 
1918  SUBROUTINE equationsmatrices_nodalvectorcalculate(nodalVector,updateVector,rowNodeNumber,rowsFieldVariable, &
1919  & err,error,*)
1920 
1921  !Argument variables
1922  TYPE(nodalvectortype) :: nodalVector
1923  LOGICAL :: updateVector
1924  INTEGER(INTG), INTENT(IN) :: rowNodeNumber
1925  TYPE(field_variable_type), POINTER :: rowsFieldVariable
1926  INTEGER(INTG), INTENT(OUT) :: err
1927  TYPE(varying_string), INTENT(OUT) :: error
1928  !Local Variables
1929  INTEGER(INTG) :: componentIdx,localRow
1930  INTEGER(INTG) :: numberOfDerivatives,numberOfVersions,versionIdx,derivativeIdx
1931  TYPE(domain_nodes_type), POINTER :: nodesTopology
1932  TYPE(varying_string) :: localError
1933 
1934  enters("EquationsMatrices_NodalVectorCalculate",err,error,*999)
1935 
1936  IF(ASSOCIATED(rowsfieldvariable)) THEN
1937  !Calculate the rows for the nodal vector
1938  nodalvector%numberOfRows=0
1939  IF(updatevector) THEN
1940  DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1941  nodestopology=>rowsfieldvariable%components(componentidx)%domain%topology%nodes
1942  IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES) THEN
1943  SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1944  CASE(field_constant_interpolation)
1945  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1946  nodalvector%numberOfRows=nodalvector%numberOfRows+1
1947  nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1948  CASE(field_element_based_interpolation)
1949  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1950  & elements(rownodenumber)
1951  nodalvector%numberOfRows=nodalvector%numberOfRows+1
1952  nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1953  CASE(field_node_based_interpolation)
1954  numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1955  & number_of_derivatives
1956  DO derivativeidx=1,numberofderivatives
1957  numberofversions=rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1958  & derivatives(derivativeidx)%numberOfVersions
1959  DO versionidx=1,numberofversions
1960  localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1961  & nodes(rownodenumber)%derivatives(derivativeidx)%versions(versionidx)
1962  nodalvector%numberOfRows=nodalvector%numberOfRows+1
1963  nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1964  ENDDO !versionIdx
1965  ENDDO !derivativeIdx
1966  CASE(field_grid_point_based_interpolation)
1967  CALL flagerror("Not implemented.",err,error,*999)
1968  CASE(field_gauss_point_based_interpolation)
1969  CALL flagerror("Not implemented.",err,error,*999)
1970  CASE DEFAULT
1971  localerror="The interpolation type of "// &
1972  & trim(numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,"*",err,error))// &
1973  & " is invalid for component number "// &
1974  & trim(numbertovstring(componentidx,"*",err,error))// &
1975  & " of rows field variable type "// &
1976  & trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))//"."
1977  CALL flagerror(localerror,err,error,*999)
1978  END SELECT
1979  ELSE
1980  localerror="Node number "//trim(numbertovstring(rownodenumber,"*",err,error))// &
1981  & " is invalid for component number "//trim(numbertovstring(componentidx,"*",err,error))// &
1982  & " of rows field variable type "//trim(numbertovstring(rowsfieldvariable%VARIABLE_TYPE,"*",err,error))// &
1983  & ". The nodal number must be between 1 and "// &
1984  & trim(numbertovstring(nodestopology%TOTAL_NUMBER_OF_NODES,"*",err,error))//"."
1985  CALL flagerror(localerror,err,error,*999)
1986  ENDIF
1987  ENDDO !componentIdx
1988  nodalvector%vector=0.0_dp
1989  ENDIF
1990  ELSE
1991  CALL flagerror("Rows field variable is not associated.",err,error,*999)
1992  ENDIF
1993 
1994  exits("EquationsMatrices_NodalVectorCalculate")
1995  RETURN
1996 999 errorsexits("EquationsMatrices_NodalVectorCalculate",err,error)
1997  RETURN 1
1998 
1999  END SUBROUTINE equationsmatrices_nodalvectorcalculate
2000 
2001  !
2002  !================================================================================================================================
2003  !
2004 
2006  SUBROUTINE equationsmatrices_nodeadd(equationsMatrices,err,error,*)
2007 
2008  !Argument variables
2009  TYPE(equations_matrices_type), POINTER :: equationsMatrices
2010  INTEGER(INTG), INTENT(OUT) :: err
2011  TYPE(varying_string), INTENT(OUT) :: error
2012  !Local Variables
2013  INTEGER(INTG) :: columnIdx,matrixIdx,rowIdx
2014  REAL(DP) :: sum
2015  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
2016  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
2017  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
2018  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
2019  TYPE(equations_matrices_source_type), POINTER :: sourceVector
2020  TYPE(equations_matrix_type), POINTER :: equationsMatrix
2021  TYPE(varying_string) :: localError
2022 
2023 #ifdef TAUPROF
2024  CALL tau_static_phase_start("EquationsMatrices_NodeAdd()")
2025 #endif
2026 
2027  enters("EquationsMatrices_NodeAdd",err,error,*999)
2028 
2029  IF(ASSOCIATED(equationsmatrices)) THEN
2030  dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2031  IF(ASSOCIATED(dynamicmatrices)) THEN
2032  !Add the nodal matrices
2033  DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2034  equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2035  IF(ASSOCIATED(equationsmatrix)) THEN
2036  IF(equationsmatrix%UPDATE_MATRIX) THEN
2037  !Handle lumped matrices
2038  IF(equationsmatrix%LUMPED) THEN
2039  DO rowidx=1,equationsmatrix%NodalMatrix%numberOfRows
2040  sum=0.0_dp
2041  DO columnidx=1,equationsmatrix%NodalMatrix%numberOfColumns
2042  sum=sum+equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)
2043  equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)=0.0_dp
2044  ENDDO !columnIdx
2045  equationsmatrix%NodalMatrix%matrix(rowidx,rowidx)=sum
2046  !Add the nodal matrice into the distributed equations matrix
2047  CALL distributed_matrix_values_add(equationsmatrix%matrix,equationsmatrix%NodalMatrix%rowDofs(rowidx), &
2048  & equationsmatrix%NodalMatrix%columnDofs(rowidx),equationsmatrix%NodalMatrix%matrix(rowidx, &
2049  & rowidx),err,error,*999)
2050  ENDDO !rowIdx
2051  ELSE
2052  !Add the nodal matrice into the distributed equations matrix
2053  CALL distributed_matrix_values_add(equationsmatrix%matrix,equationsmatrix%NodalMatrix%rowDofs(1: &
2054  & equationsmatrix%NodalMatrix%numberOfRows),equationsmatrix%NodalMatrix%columnDofs(1: &
2055  & equationsmatrix%NodalMatrix%numberOfColumns),equationsmatrix%NodalMatrix%matrix(1: &
2056  & equationsmatrix%NodalMatrix%numberOfRows,1:equationsmatrix%NodalMatrix%numberOfColumns), &
2057  & err,error,*999)
2058  ENDIF
2059  ENDIF
2060  ELSE
2061  localerror="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2062  & " is not associated."
2063  CALL flagerror(localerror,err,error,*999)
2064  ENDIF
2065  ENDDO !matrixIdx
2066  ENDIF
2067  linearmatrices=>equationsmatrices%LINEAR_MATRICES
2068  IF(ASSOCIATED(linearmatrices)) THEN
2069  !Add the nodal matrices
2070  DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2071  equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2072  IF(ASSOCIATED(equationsmatrix)) THEN
2073  IF(equationsmatrix%UPDATE_MATRIX) THEN
2074  !Handle lumped matrices
2075  IF(equationsmatrix%LUMPED) THEN
2076  DO rowidx=1,equationsmatrix%NodalMatrix%numberOfRows
2077  sum=0.0_dp
2078  DO columnidx=1,equationsmatrix%NodalMatrix%numberOfColumns
2079  sum=sum+equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)
2080  equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)=0.0_dp
2081  ENDDO !columnIdx
2082  equationsmatrix%NodalMatrix%matrix(rowidx,rowidx)=sum
2083  !Add the nodal matrice into the distributed equations matrix
2084  CALL distributed_matrix_values_add(equationsmatrix%matrix,equationsmatrix%NodalMatrix%rowDofs(rowidx), &
2085  & equationsmatrix%NodalMatrix%columnDofs(rowidx),equationsmatrix%NodalMatrix%matrix(rowidx, &
2086  & rowidx),err,error,*999)
2087  ENDDO !rowIdx
2088  ELSE
2089  !Add the nodal matrice into the distributed equations matrix
2090  CALL distributed_matrix_values_add(equationsmatrix%matrix,equationsmatrix%NodalMatrix%rowDofs(1: &
2091  & equationsmatrix%NodalMatrix%numberOfRows),equationsmatrix%NodalMatrix%columnDofs(1: &
2092  & equationsmatrix%NodalMatrix%numberOfColumns),equationsmatrix%NodalMatrix%matrix(1: &
2093  & equationsmatrix%NodalMatrix%numberOfRows,1:equationsmatrix%NodalMatrix%numberOfColumns), &
2094  & err,error,*999)
2095  ENDIF
2096  ENDIF
2097  ELSE
2098  localerror="Equations matrix for linear matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2099  & " is not associated."
2100  CALL flagerror(localerror,err,error,*999)
2101  ENDIF
2102  ENDDO !matrixIdx
2103  ENDIF
2104  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2105  IF(ASSOCIATED(nonlinearmatrices)) THEN
2106  IF(nonlinearmatrices%UPDATE_RESIDUAL) THEN
2107  !Add the residual nodal vector
2108  CALL distributed_vector_values_add(nonlinearmatrices%RESIDUAL,nonlinearmatrices%NodalResidual%rowDofs(1: &
2109  & nonlinearmatrices%NodalResidual%numberOfRows),nonlinearmatrices%NodalResidual%vector(1:nonlinearmatrices% &
2110  & nodalresidual%numberOfRows),err,error,*999)
2111  ENDIF
2112  ENDIF
2113  rhsvector=>equationsmatrices%RHS_VECTOR
2114  IF(ASSOCIATED(rhsvector)) THEN
2115  IF(rhsvector%UPDATE_VECTOR) THEN
2116  !Add the rhs nodal vector
2117  CALL distributed_vector_values_add(rhsvector%vector,rhsvector%NodalVector%rowDofs(1: &
2118  & rhsvector%NodalVector%numberOfRows),rhsvector%NodalVector%vector(1:rhsvector% &
2119  & nodalvector%numberOfRows),err,error,*999)
2120  ENDIF
2121  ENDIF
2122  sourcevector=>equationsmatrices%SOURCE_VECTOR
2123  IF(ASSOCIATED(sourcevector)) THEN
2124  IF(sourcevector%UPDATE_VECTOR) THEN
2125  !Add the rhs nodal vector
2126  CALL distributed_vector_values_add(sourcevector%vector,sourcevector%NodalVector%rowDofs(1: &
2127  & sourcevector%NodalVector%numberOfRows),sourcevector%NodalVector%vector(1:sourcevector% &
2128  & nodalvector%numberOfRows),err,error,*999)
2129  ENDIF
2130  ENDIF
2131  ELSE
2132  CALL flagerror("Equations matrices is not allocated.",err,error,*999)
2133  ENDIF
2134 #ifdef TAUPROF
2135  CALL tau_static_phase_stop("EquationsMatrices_NodeAdd()")
2136 #endif
2137 
2138  exits("EquationsMatrices_NodeAdd")
2139  RETURN
2140 999 errorsexits("EquationsMatrices_NodeAdd",err,error)
2141  RETURN 1
2142  END SUBROUTINE equationsmatrices_nodeadd
2143 
2144  !
2145  !================================================================================================================================
2146  !
2147 
2149  SUBROUTINE equationsmatrices_nodalinitialise(equationsMatrices,err,error,*)
2150 
2151  !Argument variables
2152  TYPE(equations_matrices_type), POINTER :: equationsMatrices !The equations matrices to initialise the nodal information for
2153  INTEGER(INTG), INTENT(OUT) :: err
2154  TYPE(varying_string), INTENT(OUT) :: error
2155  !Local Variables
2156  INTEGER(INTG) :: matrixIdx
2157  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
2158  TYPE(equations_mapping_type), POINTER :: equationsMapping
2159  TYPE(equations_mapping_dynamic_type), POINTER :: dynamicMapping
2160  TYPE(equations_mapping_linear_type), POINTER :: linearMapping
2161  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
2162  TYPE(equations_mapping_rhs_type), POINTER :: rhsMapping
2163  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
2164  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
2165  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
2166  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
2167  TYPE(equations_matrices_source_type), POINTER :: sourceVector
2168  TYPE(equations_matrix_type), POINTER :: equationsMatrix
2169  TYPE(field_variable_type), POINTER :: fieldVariable,columnFieldVariable
2170  TYPE(varying_string) :: localError
2171 
2172  enters("EquationsMatrices_NodalInitialise",err,error,*999)
2173 
2174  IF(ASSOCIATED(equationsmatrices)) THEN
2175  equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
2176  IF(ASSOCIATED(equationsmapping)) THEN
2177  dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2178  IF(ASSOCIATED(dynamicmatrices)) THEN
2179  !Initialise the dynamic nodal matrices
2180  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
2181  IF(ASSOCIATED(dynamicmapping)) THEN
2182  DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2183  equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2184  IF(ASSOCIATED(equationsmatrix)) THEN
2185  fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
2186  CALL equationsmatrices_nodalmatrixsetup(equationsmatrix%NodalMatrix,fieldvariable,fieldvariable, &
2187  & err,error,*999)
2188  ELSE
2189  localerror="Equations dynamic matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2190  & " is not associated."
2191  CALL flagerror(localerror,err,error,*999)
2192  ENDIF
2193  ENDDO !matrixIdx
2194  ELSE
2195  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
2196  ENDIF
2197  ENDIF
2198  linearmatrices=>equationsmatrices%LINEAR_MATRICES
2199  IF(ASSOCIATED(linearmatrices)) THEN
2200  !Initialise the linear nodal matrices
2201  linearmapping=>equationsmapping%LINEAR_MAPPING
2202  IF(ASSOCIATED(linearmapping)) THEN
2203  DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2204  equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2205  IF(ASSOCIATED(equationsmatrix)) THEN
2206  fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
2207  CALL equationsmatrices_nodalmatrixsetup(equationsmatrix%NodalMatrix,fieldvariable,fieldvariable, &
2208  & err,error,*999)
2209  ELSE
2210  localerror="Equations linear matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2211  & " is not associated."
2212  CALL flagerror(localerror,err,error,*999)
2213  ENDIF
2214  ENDDO !matrixIdx
2215  ELSE
2216  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
2217  ENDIF
2218  ENDIF
2219  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2220  IF(ASSOCIATED(nonlinearmatrices)) THEN
2221  !Initialise the Jacobian nodal matrices
2222  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
2223  IF(ASSOCIATED(nonlinearmapping)) THEN
2224  fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2225  DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2226  jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
2227  IF(ASSOCIATED(jacobianmatrix)) THEN
2228  columnfieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixidx)%VARIABLE
2229  CALL equationsmatrices_nodalmatrixsetup(jacobianmatrix%NodalJacobian,fieldvariable,columnfieldvariable, &
2230  & err,error,*999)
2231  ELSE
2232  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
2233  ENDIF
2234  ENDDO
2235  !Use RHS variable for residual vector, otherwise first nonlinear variable if no RHS
2236  rhsmapping=>equationsmapping%RHS_MAPPING
2237  IF(ASSOCIATED(rhsmapping)) THEN
2238  fieldvariable=>rhsmapping%RHS_VARIABLE
2239  ELSE
2240  fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2241  ENDIF
2242  CALL equationsmatrices_nodalvectorsetup(nonlinearmatrices%NodalResidual,fieldvariable,err,error,*999)
2243  nonlinearmatrices%NodalResidualCalculated=0
2244  ELSE
2245  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
2246  ENDIF
2247  ENDIF
2248  rhsvector=>equationsmatrices%RHS_VECTOR
2249  IF(ASSOCIATED(rhsvector)) THEN
2250  !Initialise the RHS nodal vector
2251  rhsmapping=>equationsmapping%RHS_MAPPING
2252  IF(ASSOCIATED(rhsmapping)) THEN
2253  fieldvariable=>rhsmapping%RHS_VARIABLE
2254  CALL equationsmatrices_nodalvectorsetup(rhsvector%NodalVector,fieldvariable,err,error,*999)
2255  ELSE
2256  CALL flagerror("RHS mapping is not associated.",err,error,*999)
2257  ENDIF
2258  ENDIF
2259  sourcevector=>equationsmatrices%SOURCE_VECTOR
2260  IF(ASSOCIATED(sourcevector)) THEN
2261  !Initialise the source nodal vector. Note that the number of rows in the source vector is taken, for now, from the RHS
2262  !vector
2263  IF(ASSOCIATED(rhsvector)) THEN
2264  !Initialise the RHS nodal vector
2265  rhsmapping=>equationsmapping%RHS_MAPPING
2266  IF(ASSOCIATED(rhsmapping)) THEN
2267  fieldvariable=>rhsmapping%RHS_VARIABLE
2268  CALL equationsmatrices_nodalvectorsetup(sourcevector%NodalVector,fieldvariable,err,error,*999)
2269  ELSE
2270  CALL flagerror("RHS mapping is not associated.",err,error,*999)
2271  ENDIF
2272  ELSE
2273  CALL flagerror("Not implemented.",err,error,*999)
2274  ENDIF
2275  ENDIF
2276  ELSE
2277  CALL flagerror("Equations matrices mapping is not associated.",err,error,*999)
2278  ENDIF
2279  ELSE
2280  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2281  ENDIF
2282 
2283  exits("EquationsMatrices_NodalInitialise")
2284  RETURN
2285 999 errorsexits("EquationsMatrices_NodalInitialise",err,error)
2286  RETURN 1
2287  END SUBROUTINE equationsmatrices_nodalinitialise
2288 
2289  !
2290  !================================================================================================================================
2291  !
2292 
2294  SUBROUTINE equationsmatrices_nodalmatrixsetup(nodalMatrix,rowsFieldVariable,colsFieldVariable,err,error,*)
2295 
2296  !Argument variables
2297  TYPE(nodalmatrixtype) :: nodalMatrix
2298  TYPE(field_variable_type), POINTER :: rowsFieldVariable
2299  TYPE(field_variable_type), POINTER :: colsFieldVariable
2300  INTEGER(INTG), INTENT(OUT) :: err
2301  TYPE(varying_string), INTENT(OUT) :: error
2302  !Local Variables
2303  INTEGER(INTG) :: dummyErr
2304  TYPE(varying_string) :: dummyError
2305 
2306  enters("EquationsMatrices_NodalMatrixSetup",err,error,*998)
2307 
2308  IF(ASSOCIATED(rowsfieldvariable)) THEN
2309  IF(ASSOCIATED(colsfieldvariable)) THEN
2310  nodalmatrix%maxNumberOfRows=rowsfieldvariable%maxNumberNodeInterpolationParameters* &
2311  & rowsfieldvariable%NUMBER_OF_COMPONENTS
2312  nodalmatrix%maxNumberOfColumns=colsfieldvariable%maxNumberNodeInterpolationParameters* &
2313  & colsfieldvariable%NUMBER_OF_COMPONENTS
2314  IF(ALLOCATED(nodalmatrix%rowDofs)) THEN
2315  CALL flagerror("Nodal matrix row dofs already allocated.",err,error,*999)
2316  ELSE
2317  ALLOCATE(nodalmatrix%rowDofs(nodalmatrix%maxNumberOfRows),stat=err)
2318  IF(err/=0) CALL flagerror("Could not allocate nodal matrix row dofs.",err,error,*999)
2319  ENDIF
2320  IF(ALLOCATED(nodalmatrix%columnDofs)) THEN
2321  CALL flagerror("Nodal matrix column dofs already allocated.",err,error,*999)
2322  ELSE
2323  ALLOCATE(nodalmatrix%columnDofs(nodalmatrix%maxNumberOfColumns),stat=err)
2324  IF(err/=0) CALL flagerror("Could not allocate nodal matrix column dofs.",err,error,*999)
2325  ENDIF
2326  IF(ALLOCATED(nodalmatrix%matrix)) THEN
2327  CALL flagerror("Nodal matrix already allocated.",err,error,*999)
2328  ELSE
2329  ALLOCATE(nodalmatrix%matrix(nodalmatrix%maxNumberOfRows,nodalmatrix%maxNumberOfColumns),stat=err)
2330  IF(err/=0) CALL flagerror("Could not allocate nodal matrix.",err,error,*999)
2331  ENDIF
2332  ELSE
2333  CALL flagerror("Columns field variable is not associated.",err,error,*999)
2334  ENDIF
2335  ELSE
2336  CALL flagerror("Rows field variable is not associated.",err,error,*999)
2337  ENDIF
2338 
2339  exits("EquationsMatrices_NodalMatrixSetup")
2340  RETURN
2341 999 CALL equationsmatrices_nodalmatrixfinalise(nodalmatrix,dummyerr,dummyerror,*998)
2342 998 errorsexits("EquationsMatrices_NodalMatrixSetup",err,error)
2343  RETURN 1
2344  END SUBROUTINE equationsmatrices_nodalmatrixsetup
2345 
2346  !
2347  !================================================================================================================================
2348  !
2349 
2351  SUBROUTINE equationsmatrices_nodalvectorsetup(nodalVector,rowsFieldVariable,err,error,*)
2352 
2353  !Argument variables
2354  TYPE(nodalvectortype) :: nodalVector
2355  TYPE(field_variable_type), POINTER :: rowsFieldVariable
2356  INTEGER(INTG), INTENT(OUT) :: err
2357  TYPE(varying_string), INTENT(OUT) :: error
2358  !Local Variables
2359  INTEGER(INTG) :: dummyErr
2360  TYPE(varying_string) :: dummyError
2361 
2362  enters("EquationsMatrices_NodalVectorSetup",err,error,*998)
2363 
2364  IF(ASSOCIATED(rowsfieldvariable)) THEN
2365  nodalvector%maxNumberOfRows=rowsfieldvariable%maxNumberNodeInterpolationParameters* &
2366  & rowsfieldvariable%NUMBER_OF_COMPONENTS
2367  IF(ALLOCATED(nodalvector%rowDofs)) THEN
2368  CALL flagerror("Nodal vector row dofs is already allocated.",err,error,*999)
2369  ELSE
2370  ALLOCATE(nodalvector%rowDofs(nodalvector%maxNumberOfRows),stat=err)
2371  IF(err/=0) CALL flagerror("Could not allocate nodal vector row dofs.",err,error,*999)
2372  ENDIF
2373  IF(ALLOCATED(nodalvector%vector)) THEN
2374  CALL flagerror("Nodal vector vector already allocated.",err,error,*999)
2375  ELSE
2376  ALLOCATE(nodalvector%vector(nodalvector%maxNumberOfRows),stat=err)
2377  IF(err/=0) CALL flagerror("Could not allocate nodal vector vector.",err,error,*999)
2378  ENDIF
2379  ELSE
2380  CALL flagerror("Rows field variable is not associated.",err,error,*999)
2381  ENDIF
2382 
2383  exits("EquationsMatrices_NodalVectorSetup")
2384  RETURN
2385 999 CALL equationsmatrices_nodalvectorfinalise(nodalvector,dummyerr,dummyerror,*998)
2386 998 errorsexits("EquationsMatrices_NodalVectorSetup",err,error)
2387  RETURN 1
2388  END SUBROUTINE equationsmatrices_nodalvectorsetup
2389 
2390  !
2391  !================================================================================================================================
2392  !
2393 
2395  SUBROUTINE equationsmatrices_nodalfinalise(equationsMatrices,err,error,*)
2396 
2397  !Argument variables
2398  TYPE(equations_matrices_type), POINTER :: equationsMatrices
2399  INTEGER(INTG), INTENT(OUT) :: err
2400  TYPE(varying_string), INTENT(OUT) :: error
2401  !Local Variables
2402  INTEGER(INTG) :: matrixIdx
2403  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
2404  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
2405  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
2406  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
2407  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
2408  TYPE(equations_matrices_source_type), POINTER :: sourceVector
2409  TYPE(equations_matrix_type), POINTER :: equationsMatrix
2410  TYPE(varying_string) :: localError
2411 
2412  enters("EquationsMatrices_NodalFinalise",err,error,*999)
2413 
2414  IF(ASSOCIATED(equationsmatrices)) THEN
2415  dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2416  IF(ASSOCIATED(dynamicmatrices)) THEN
2417  !Finalise the dynamic nodal matrices
2418  DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2419  equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2420  IF(ASSOCIATED(equationsmatrix)) THEN
2421  equationsmatrix%NodalMatrix%maxNumberOfRows=0
2422  equationsmatrix%NodalMatrix%maxNumberOfColumns=0
2423  IF(ALLOCATED(equationsmatrix%NodalMatrix%rowDofs)) DEALLOCATE(equationsmatrix%NodalMatrix%rowDofs)
2424  IF(ALLOCATED(equationsmatrix%NodalMatrix%columnDofs)) DEALLOCATE(equationsmatrix%NodalMatrix%columnDofs)
2425  IF(ALLOCATED(equationsmatrix%NodalMatrix%matrix)) DEALLOCATE(equationsmatrix%NodalMatrix%matrix)
2426  ELSE
2427  localerror="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2428  & " is not associated."
2429  CALL flagerror(localerror,err,error,*999)
2430  ENDIF
2431  ENDDO !matrixIdx
2432  ENDIF
2433  linearmatrices=>equationsmatrices%LINEAR_MATRICES
2434  IF(ASSOCIATED(linearmatrices)) THEN
2435  !Finalise the linear nodal matrices
2436  DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2437  equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2438  IF(ASSOCIATED(equationsmatrix)) THEN
2439  equationsmatrix%NodalMatrix%maxNumberOfRows=0
2440  equationsmatrix%NodalMatrix%maxNumberOfColumns=0
2441  IF(ALLOCATED(equationsmatrix%NodalMatrix%rowDofs)) DEALLOCATE(equationsmatrix%NodalMatrix%rowDofs)
2442  IF(ALLOCATED(equationsmatrix%NodalMatrix%columnDofs)) DEALLOCATE(equationsmatrix%NodalMatrix%columnDofs)
2443  IF(ALLOCATED(equationsmatrix%NodalMatrix%matrix)) DEALLOCATE(equationsmatrix%NodalMatrix%matrix)
2444  ELSE
2445  localerror="Equations matrix for linear matrix number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2446  & " is not associated."
2447  CALL flagerror(localerror,err,error,*999)
2448  ENDIF
2449  ENDDO !matrixIdx
2450  ENDIF
2451  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2452  IF(ASSOCIATED(nonlinearmatrices)) THEN
2453  DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2454  jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
2455  IF(ASSOCIATED(jacobianmatrix)) THEN
2456  jacobianmatrix%NodalJacobian%maxNumberOfRows=0
2457  jacobianmatrix%NodalJacobian%maxNumberOfColumns=0
2458  IF(ALLOCATED(jacobianmatrix%NodalJacobian%rowDofs)) DEALLOCATE(jacobianmatrix%NodalJacobian%rowDofs)
2459  IF(ALLOCATED(jacobianmatrix%NodalJacobian%columnDofs)) DEALLOCATE(jacobianmatrix%NodalJacobian%columnDofs)
2460  IF(ALLOCATED(jacobianmatrix%NodalJacobian%matrix)) DEALLOCATE(jacobianmatrix%NodalJacobian%matrix)
2461  ELSE
2462  CALL flagerror("Nonlinear matrices Jacobian number "//trim(numbertovstring(matrixidx,"*",err,error))// &
2463  & " is not associated.",err,error,*999)
2464  ENDIF
2465  ENDDO
2466  nonlinearmatrices%NodalResidual%maxNumberOfRows=0
2467  IF(ALLOCATED(nonlinearmatrices%NodalResidual%rowDofs)) DEALLOCATE(nonlinearmatrices%NodalResidual%rowDofs)
2468  IF(ALLOCATED(nonlinearmatrices%NodalResidual%vector)) DEALLOCATE(nonlinearmatrices%NodalResidual%vector)
2469  ENDIF
2470  rhsvector=>equationsmatrices%RHS_VECTOR
2471  IF(ASSOCIATED(rhsvector)) THEN
2472  !Finalise the nodal vector
2473  rhsvector%NodalVector%maxNumberOfRows=0
2474  IF(ALLOCATED(rhsvector%NodalVector%rowDofs)) DEALLOCATE(rhsvector%NodalVector%rowDofs)
2475  IF(ALLOCATED(rhsvector%NodalVector%vector)) DEALLOCATE(rhsvector%NodalVector%vector)
2476  ENDIF
2477  sourcevector=>equationsmatrices%SOURCE_VECTOR
2478  IF(ASSOCIATED(sourcevector)) THEN
2479  !Finalise the nodal source vector
2480  sourcevector%NodalVector%maxNumberOfRows=0
2481  IF(ALLOCATED(sourcevector%NodalVector%rowDofs)) DEALLOCATE(sourcevector%NodalVector%rowDofs)
2482  IF(ALLOCATED(sourcevector%NodalVector%vector)) DEALLOCATE(sourcevector%NodalVector%vector)
2483  ENDIF
2484  ELSE
2485  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2486  ENDIF
2487 
2488  exits("EquationsMatrices_NodalFinalise")
2489  RETURN
2490 999 errorsexits("EquationsMatrices_NodalFinalise",err,error)
2491  RETURN 1
2492  END SUBROUTINE equationsmatrices_nodalfinalise
2493 
2494  !
2495  !================================================================================================================================
2496  !
2497 
2499  SUBROUTINE equationsmatrices_nodalmatrixinitialise(nodalMatrix,err,error,*)
2500 
2501  !Argument variables
2502  TYPE(nodalmatrixtype) :: nodalMatrix !The nodal matrix to initialise
2503  INTEGER(INTG), INTENT(OUT) :: err
2504  TYPE(varying_string), INTENT(OUT) :: error
2505  !Local Variables
2506 
2507  enters("EquationsMatrices_NodalMatrixInitialise",err,error,*999)
2508 
2509  nodalmatrix%equationsMatrixNumber=0
2510  nodalmatrix%numberOfRows=0
2511  nodalmatrix%numberOfColumns=0
2512  nodalmatrix%maxNumberOfRows=0
2513  nodalmatrix%maxNumberOfColumns=0
2514 
2515  exits("EquationsMatrices_NodalMatrixInitialise")
2516  RETURN
2517 999 errorsexits("EquationsMatrices_NodalMatrixInitialise",err,error)
2518  RETURN 1
2519  END SUBROUTINE equationsmatrices_nodalmatrixinitialise
2520 
2521  !
2522  !================================================================================================================================
2523  !
2524 
2526  SUBROUTINE equationsmatrices_nodalmatrixfinalise(nodalMatrix,err,error,*)
2527 
2528  !Argument variables
2529  TYPE(nodalmatrixtype):: nodalMatrix
2530  INTEGER(INTG), INTENT(OUT) :: err
2531  TYPE(varying_string), INTENT(OUT) :: error
2532  !Local Variables
2533 
2534  enters("EquationsMatrices_NodalMatrixFinalise",err,error,*999)
2535 
2536  IF(ALLOCATED(nodalmatrix%rowDofs)) DEALLOCATE(nodalmatrix%rowDofs)
2537  IF(ALLOCATED(nodalmatrix%columnDofs)) DEALLOCATE(nodalmatrix%columnDofs)
2538  IF(ALLOCATED(nodalmatrix%matrix)) DEALLOCATE(nodalmatrix%matrix)
2539 
2540  exits("EquationsMatrices_NodalMatrixFinalise")
2541  RETURN
2542 999 errorsexits("EquationsMatrices_NodalMatrixFinalise",err,error)
2543  RETURN 1
2544  END SUBROUTINE equationsmatrices_nodalmatrixfinalise
2545 
2546  !
2547  !================================================================================================================================
2548  !
2549 
2551  SUBROUTINE equationsmatrices_nodalvectorinitialise(nodalVector,err,error,*)
2552 
2553  !Argument variables
2554  TYPE(nodalvectortype) :: nodalVector !The nodal vector to initialise
2555  INTEGER(INTG), INTENT(OUT) :: err
2556  TYPE(varying_string), INTENT(OUT) :: error
2557  !Local Variables
2558 
2559  enters("EquationsMatrices_NodalVectorInitialise",err,error,*999)
2560 
2561  nodalvector%numberOfRows=0
2562  nodalvector%maxNumberOfRows=0
2563 
2564  exits("EquationsMatrices_NodalVectorInitialise")
2565  RETURN
2566 999 errorsexits("EquationsMatrices_NodalVectorInitialise",err,error)
2567  RETURN 1
2568  END SUBROUTINE equationsmatrices_nodalvectorinitialise
2569 
2570  !
2571  !================================================================================================================================
2572  !
2573 
2575  SUBROUTINE equationsmatrices_nodalvectorfinalise(nodalVector,err,error,*)
2576 
2577  !Argument variables
2578  TYPE(nodalvectortype):: nodalVector
2579  INTEGER(INTG), INTENT(OUT) :: err
2580  TYPE(varying_string), INTENT(OUT) :: error
2581  !Local Variables
2582 
2583  enters("EquationsMatrices_NodalVectorFinalise",err,error,*999)
2584 
2585  IF(ALLOCATED(nodalvector%rowDofs)) DEALLOCATE(nodalvector%rowDofs)
2586  IF(ALLOCATED(nodalvector%vector)) DEALLOCATE(nodalvector%vector)
2587 
2588  exits("EquationsMatrices_NodalVectorFinalise")
2589  RETURN
2590 999 errorsexits("EquationsMatrices_NodalVectorFinalise",err,error)
2591 
2592  RETURN 1
2593  END SUBROUTINE equationsmatrices_nodalvectorfinalise
2594 
2595  !
2596  !================================================================================================================================
2597  !
2598 
2600  SUBROUTINE equationsmatrices_jacobiannodeadd(equationsMatrices,err,error,*)
2601 
2602  !Argument variables
2603  TYPE(equations_matrices_type), POINTER :: equationsMatrices
2604  INTEGER(INTG), INTENT(OUT) :: err
2605  TYPE(varying_string), INTENT(OUT) :: error
2606  !Local Variables
2607  INTEGER(INTG) :: jacobianMatrixIdx
2608  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
2609  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
2610  TYPE(varying_string) :: localError
2611 
2612 #ifdef TAUPROF
2613  CALL tau_static_phase_start("EquationsMatrices_JacobianNodeAdd()")
2614 #endif
2615 
2616  enters("EquationsMatrices_JacobianNodeAdd",err,error,*999)
2617 
2618  IF(ASSOCIATED(equationsmatrices)) THEN
2619  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2620  IF(ASSOCIATED(nonlinearmatrices)) THEN
2621  DO jacobianmatrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2622  jacobianmatrix=>nonlinearmatrices%JACOBIANS(jacobianmatrixidx)%PTR
2623  IF(ASSOCIATED(jacobianmatrix)) THEN
2624  IF(jacobianmatrix%UPDATE_JACOBIAN) THEN
2625  !Add in Jacobian element matrices
2626  CALL distributed_matrix_values_add(jacobianmatrix%jacobian,jacobianmatrix%NodalJacobian%rowDofs(1: &
2627  & jacobianmatrix%NodalJacobian%numberOfRows),jacobianmatrix%NodalJacobian%columnDofs(1: &
2628  & jacobianmatrix%NodalJacobian%numberOfColumns),jacobianmatrix%NodalJacobian%matrix(1: &
2629  & jacobianmatrix%NodalJacobian%numberOfRows,1:jacobianmatrix%NodalJacobian%numberOfColumns), &
2630  & err,error,*999)
2631  ENDIF
2632  ELSE
2633  localerror="Jacobian matrix for Jacobian matrix index "// &
2634  & trim(numbertovstring(jacobianmatrixidx,"*",err,error))//" is not associated."
2635  CALL flagerror(localerror,err,error,*999)
2636  ENDIF
2637  ENDDO !jacobianMatrixIdx
2638  ENDIF
2639  ELSE
2640  CALL flagerror("Equations matrices is not allocated.",err,error,*999)
2641  ENDIF
2642 #ifdef TAUPROF
2643  CALL tau_static_phase_stop("EquationsMatrices_JacobianNodeAdd()")
2644 #endif
2645 
2646  exits("EquationsMatrices_JacobianNodeAdd")
2647  RETURN
2648 999 errorsexits("EquationsMatrices_JacobianNodeAdd",err,error)
2649  RETURN 1
2650  END SUBROUTINE equationsmatrices_jacobiannodeadd
2651 
2652  !
2653  !================================================================================================================================
2654  !
2655 
2657  SUBROUTINE equations_matrices_element_finalise(EQUATIONS_MATRICES,ERR,ERROR,*)
2658 
2659  !Argument variables
2660  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2661  INTEGER(INTG), INTENT(OUT) :: ERR
2662  TYPE(varying_string), INTENT(OUT) :: ERROR
2663  !Local Variables
2664  INTEGER(INTG) :: matrix_idx
2665  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
2666  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2667  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
2668  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2669  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2670  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
2671  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
2672  TYPE(varying_string) :: LOCAL_ERROR
2673 
2674  enters("EQUATIONS_MATRICES_ELEMENT_FINALISE",err,error,*999)
2675 
2676  IF(ASSOCIATED(equations_matrices)) THEN
2677  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2678  IF(ASSOCIATED(dynamic_matrices)) THEN
2679  !Finalise the dynamic element matrices
2680  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2681  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
2682  IF(ASSOCIATED(equations_matrix)) THEN
2683  CALL equations_matrices_element_matrix_finalise(equations_matrix%ELEMENT_MATRIX,err,error,*999)
2684  ELSE
2685  local_error="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2686  & " is not associated."
2687  CALL flagerror(local_error,err,error,*999)
2688  ENDIF
2689  ENDDO !matrix_idx
2690  ENDIF
2691  linear_matrices=>equations_matrices%LINEAR_MATRICES
2692  IF(ASSOCIATED(linear_matrices)) THEN
2693  !Finalise the linear element matrices
2694  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2695  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
2696  IF(ASSOCIATED(equations_matrix)) THEN
2697  CALL equations_matrices_element_matrix_finalise(equations_matrix%ELEMENT_MATRIX,err,error,*999)
2698  ELSE
2699  local_error="Equations matrix for linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2700  & " is not associated."
2701  CALL flagerror(local_error,err,error,*999)
2702  ENDIF
2703  ENDDO !matrix_idx
2704  ENDIF
2705  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2706  IF(ASSOCIATED(nonlinear_matrices)) THEN
2707  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2708  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
2709  IF(ASSOCIATED(jacobian_matrix)) THEN
2710  jacobian_matrix%ELEMENT_JACOBIAN%MAX_NUMBER_OF_ROWS=0
2711  jacobian_matrix%ELEMENT_JACOBIAN%MAX_NUMBER_OF_COLUMNS=0
2712  IF(ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%ROW_DOFS)) DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%ROW_DOFS)
2713  IF(ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS)) DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS)
2714  IF(ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%MATRIX)) DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%MATRIX)
2715  ELSE
2716  CALL flagerror("Nonlinear matrices Jacobian number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2717  & " is not associated.",err,error,*999)
2718  ENDIF
2719  ENDDO
2720  nonlinear_matrices%ELEMENT_RESIDUAL%MAX_NUMBER_OF_ROWS=0
2721  IF(ALLOCATED(nonlinear_matrices%ELEMENT_RESIDUAL%ROW_DOFS)) DEALLOCATE(nonlinear_matrices%ELEMENT_RESIDUAL%ROW_DOFS)
2722  IF(ALLOCATED(nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR)) DEALLOCATE(nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR)
2723  ENDIF
2724  rhs_vector=>equations_matrices%RHS_VECTOR
2725  IF(ASSOCIATED(rhs_vector)) THEN
2726  !Finalise the element vector
2727  rhs_vector%ELEMENT_VECTOR%MAX_NUMBER_OF_ROWS=0
2728  IF(ALLOCATED(rhs_vector%ELEMENT_VECTOR%ROW_DOFS)) DEALLOCATE(rhs_vector%ELEMENT_VECTOR%ROW_DOFS)
2729  IF(ALLOCATED(rhs_vector%ELEMENT_VECTOR%VECTOR)) DEALLOCATE(rhs_vector%ELEMENT_VECTOR%VECTOR)
2730  ENDIF
2731  source_vector=>equations_matrices%SOURCE_VECTOR
2732  IF(ASSOCIATED(source_vector)) THEN
2733  !Finalise the element source vector
2734  source_vector%ELEMENT_VECTOR%MAX_NUMBER_OF_ROWS=0
2735  IF(ALLOCATED(source_vector%ELEMENT_VECTOR%ROW_DOFS)) DEALLOCATE(source_vector%ELEMENT_VECTOR%ROW_DOFS)
2736  IF(ALLOCATED(source_vector%ELEMENT_VECTOR%VECTOR)) DEALLOCATE(source_vector%ELEMENT_VECTOR%VECTOR)
2737  ENDIF
2738  ELSE
2739  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2740  ENDIF
2741 
2742  exits("EQUATIONS_MATRICES_ELEMENT_FINALISE")
2743  RETURN
2744 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_FINALISE",err,error)
2745  RETURN 1
2746  END SUBROUTINE equations_matrices_element_finalise
2747 
2748  !
2749  !================================================================================================================================
2750  !
2751 
2753  SUBROUTINE equations_matrices_element_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
2754 
2755  !Argument variables
2756  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES !The equations matrices to initialise the element information for
2757  INTEGER(INTG), INTENT(OUT) :: ERR
2758  TYPE(varying_string), INTENT(OUT) :: ERROR
2759  !Local Variables
2760  INTEGER(INTG) :: matrix_idx
2761  INTEGER(INTG) :: rowsNumberOfElements,colsNumberOfElements !Number of elements in the row and col variables whose dofs are present in the element matrix
2762  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
2763  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2764  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
2765  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
2766  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
2767  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
2768  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2769  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
2770  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2771  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2772  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
2773  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
2774  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,COL_FIELD_VARIABLE
2775  TYPE(varying_string) :: LOCAL_ERROR
2776 
2777  enters("EQUATIONS_MATRICES_ELEMENT_INITIALISE",err,error,*999)
2778 
2779  IF(ASSOCIATED(equations_matrices)) THEN
2780  rowsnumberofelements=1
2781  colsnumberofelements=1
2782  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
2783  IF(ASSOCIATED(equations_mapping)) THEN
2784  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2785  IF(ASSOCIATED(dynamic_matrices)) THEN
2786  !Initialise the dynamic element matrices
2787  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2788  IF(ASSOCIATED(dynamic_mapping)) THEN
2789  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2790  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
2791  IF(ASSOCIATED(equations_matrix)) THEN
2792  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
2793  CALL equations_matrices_element_matrix_setup(equations_matrix%ELEMENT_MATRIX,field_variable,field_variable, &
2794  & rowsnumberofelements,colsnumberofelements,err,error,*999)
2795  ELSE
2796  local_error="Equations dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2797  & " is not associated."
2798  CALL flagerror(local_error,err,error,*999)
2799  ENDIF
2800  ENDDO !matrix_idx
2801  ELSE
2802  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
2803  ENDIF
2804  ENDIF
2805  linear_matrices=>equations_matrices%LINEAR_MATRICES
2806  IF(ASSOCIATED(linear_matrices)) THEN
2807  !Initialise the linear element matrices
2808  linear_mapping=>equations_mapping%LINEAR_MAPPING
2809  IF(ASSOCIATED(linear_mapping)) THEN
2810  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2811  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
2812  IF(ASSOCIATED(equations_matrix)) THEN
2813  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
2814  CALL equations_matrices_element_matrix_setup(equations_matrix%ELEMENT_MATRIX,field_variable,field_variable, &
2815  & rowsnumberofelements,colsnumberofelements,err,error,*999)
2816  ELSE
2817  local_error="Equations linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))// &
2818  & " is not associated."
2819  CALL flagerror(local_error,err,error,*999)
2820  ENDIF
2821  ENDDO !matrix_idx
2822  ELSE
2823  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*999)
2824  ENDIF
2825  ENDIF
2826  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2827  IF(ASSOCIATED(nonlinear_matrices)) THEN
2828  !Initialise the Jacobian element matrices
2829  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2830  IF(ASSOCIATED(nonlinear_mapping)) THEN
2831  field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2832  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2833  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
2834  IF(ASSOCIATED(jacobian_matrix)) THEN
2835  col_field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE
2836  CALL equations_matrices_element_matrix_setup(jacobian_matrix%ELEMENT_JACOBIAN,field_variable,col_field_variable, &
2837  & rowsnumberofelements,colsnumberofelements,err,error,*999)
2838  ELSE
2839  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
2840  ENDIF
2841  ENDDO
2842  !Use RHS variable for residual vector, otherwise first nonlinear variable if no RHS
2843  rhs_mapping=>equations_mapping%RHS_MAPPING
2844  IF(ASSOCIATED(rhs_mapping)) THEN
2845  field_variable=>rhs_mapping%RHS_VARIABLE
2846  ELSE
2847  field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2848  ENDIF
2849  CALL equations_matrices_element_vector_setup(nonlinear_matrices%ELEMENT_RESIDUAL,field_variable,err,error,*999)
2850  nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=0
2851  ELSE
2852  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
2853  ENDIF
2854  ENDIF
2855  rhs_vector=>equations_matrices%RHS_VECTOR
2856  IF(ASSOCIATED(rhs_vector)) THEN
2857  !Initialise the RHS element vector
2858  rhs_mapping=>equations_mapping%RHS_MAPPING
2859  IF(ASSOCIATED(rhs_mapping)) THEN
2860  field_variable=>rhs_mapping%RHS_VARIABLE
2861  CALL equations_matrices_element_vector_setup(rhs_vector%ELEMENT_VECTOR,field_variable,err,error,*999)
2862  ELSE
2863  CALL flagerror("RHS mapping is not associated.",err,error,*999)
2864  ENDIF
2865  ENDIF
2866  source_vector=>equations_matrices%SOURCE_VECTOR
2867  IF(ASSOCIATED(source_vector)) THEN
2868  !Initialise the source element vector. Note that the number of rows in the source vector is taken, for now, from the RHS
2869  !vector
2870  IF(ASSOCIATED(rhs_vector)) THEN
2871  !Initialise the RHS element vector
2872  rhs_mapping=>equations_mapping%RHS_MAPPING
2873  IF(ASSOCIATED(rhs_mapping)) THEN
2874  field_variable=>rhs_mapping%RHS_VARIABLE
2875  CALL equations_matrices_element_vector_setup(source_vector%ELEMENT_VECTOR,field_variable,err,error,*999)
2876  ELSE
2877  CALL flagerror("RHS mapping is not associated.",err,error,*999)
2878  ENDIF
2879  ELSE
2880  CALL flagerror("Not implemented.",err,error,*999)
2881  ENDIF
2882  ENDIF
2883  ELSE
2884  CALL flagerror("Equations matrices mapping is not associated.",err,error,*999)
2885  ENDIF
2886  ELSE
2887  CALL flagerror("Equations matrices is not associated.",err,error,*999)
2888  ENDIF
2889 
2890  exits("EQUATIONS_MATRICES_ELEMENT_INITIALISE")
2891  RETURN
2892 999 errorsexits("EQUATIONS_MATRICES_ELEMENT_INITIALISE",err,error)
2893  RETURN 1
2894  END SUBROUTINE equations_matrices_element_initialise
2895 
2896  !
2897  !================================================================================================================================
2898  !
2899 
2901  SUBROUTINE equations_matrix_finalise(EQUATIONS_MATRIX,ERR,ERROR,*)
2902 
2903  !Argument variables
2904  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
2905  INTEGER(INTG), INTENT(OUT) :: ERR
2906  TYPE(varying_string), INTENT(OUT) :: ERROR
2907  !Local Variables
2908 
2909  enters("EQUATIONS_MATRIX_FINALISE",err,error,*999)
2910 
2911  IF(ASSOCIATED(equations_matrix)) THEN
2912  IF(ASSOCIATED(equations_matrix%MATRIX)) CALL distributed_matrix_destroy(equations_matrix%MATRIX,err,error,*999)
2913  CALL equations_matrices_element_matrix_finalise(equations_matrix%ELEMENT_MATRIX,err,error,*999)
2914  CALL equationsmatrices_nodalmatrixfinalise(equations_matrix%NodalMatrix,err,error,*999)
2915  IF(ASSOCIATED(equations_matrix%TEMP_VECTOR)) CALL distributed_vector_destroy(equations_matrix%TEMP_VECTOR,err,error,*999)
2916  ENDIF
2917 
2918  exits("EQUATIONS_MATRIX_FINALISE")
2919  RETURN
2920 999 errorsexits("EQUATIONS_MATRIX_FINALISE",err,error)
2921  RETURN 1
2922  END SUBROUTINE equations_matrix_finalise
2923 
2924  !
2925  !================================================================================================================================
2926  !
2927 
2929  SUBROUTINE equations_matrix_dynamic_initialise(DYNAMIC_MATRICES,MATRIX_NUMBER,ERR,ERROR,*)
2930 
2931  !Argument variables
2932  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2933  INTEGER(INTG) :: MATRIX_NUMBER
2934  INTEGER(INTG), INTENT(OUT) :: ERR
2935  TYPE(varying_string), INTENT(OUT) :: ERROR
2936  !Local Variables
2937  INTEGER(INTG) :: DUMMY_ERR
2938  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2939  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
2940  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2941  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
2942  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
2943 
2944  enters("EQUATIONS_MATRIX_DYNAMIC_INITIALISE",err,error,*998)
2945 
2946  IF(ASSOCIATED(dynamic_matrices)) THEN
2947  IF(matrix_number>0.AND.matrix_number<=dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES) THEN
2948  equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
2949  IF(ASSOCIATED(equations_matrices)) THEN
2950  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
2951  IF(ASSOCIATED(equations_mapping)) THEN
2952  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2953  IF(ASSOCIATED(dynamic_mapping)) THEN
2954  IF(ASSOCIATED(dynamic_matrices%MATRICES(matrix_number)%PTR)) THEN
2955  local_error="Equations matrix for dynamic matrix number "//trim(numbertovstring(matrix_number,"*",err,error))// &
2956  & " is already associated."
2957  CALL flagerror(local_error,err,error,*998)
2958  ELSE
2959  ALLOCATE(dynamic_matrices%MATRICES(matrix_number)%PTR,stat=err)
2960  IF(err/=0) CALL flagerror("Could not allocate equations matrix.",err,error,*999)
2961  equations_matrix=>dynamic_matrices%MATRICES(matrix_number)%PTR
2962  equations_matrix%MATRIX_NUMBER=matrix_number
2963  equations_matrix%DYNAMIC_MATRICES=>dynamic_matrices
2964  NULLIFY(equations_matrix%LINEAR_MATRICES)
2965  equations_matrix%STORAGE_TYPE=matrix_block_storage_type
2966  equations_matrix%STRUCTURE_TYPE=equations_matrix_no_structure
2967  equations_matrix%LUMPED=.false.
2968  equations_matrix%UPDATE_MATRIX=.true.
2969  equations_matrix%FIRST_ASSEMBLY=.true.
2970  equations_matrix%NUMBER_OF_COLUMNS=dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%NUMBER_OF_COLUMNS
2971  dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%EQUATIONS_MATRIX=>equations_matrix
2972  NULLIFY(equations_matrix%MATRIX)
2973  CALL equationsmatrices_elementmatrixinitialise(equations_matrix%ELEMENT_MATRIX,err,error,*999)
2974  CALL equationsmatrices_nodalmatrixinitialise(equations_matrix%NodalMatrix,err,error,*999)
2975  NULLIFY(equations_matrix%TEMP_VECTOR)
2976  ENDIF
2977  ELSE
2978  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*998)
2979  ENDIF
2980  ELSE
2981  CALL flagerror("Equations mapping is not associated.",err,error,*998)
2982  ENDIF
2983  ELSE
2984  CALL flagerror("Dynamic matrices equations matrices is not associated.",err,error,*998)
2985  ENDIF
2986  ELSE
2987  local_error="The specified dynamic matrix number of "//trim(numbertovstring(matrix_number,"*",err,error))// &
2988  & " is invalid. The matrix number must be > 0 and <= "// &
2989  & trim(numbertovstring(dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,"*",err,error))//"."
2990  CALL flagerror(local_error,err,error,*998)
2991  ENDIF
2992  ELSE
2993  CALL flagerror("Dynamic matrices is not associated.",err,error,*998)
2994  ENDIF
2995 
2996  exits("EQUATIONS_MATRIX_DYNAMIC_INITIALISE")
2997  RETURN
2998 999 CALL equations_matrix_finalise(dynamic_matrices%MATRICES(matrix_number)%PTR,dummy_err,dummy_error,*998)
2999 998 errorsexits("EQUATIONS_MATRIX_DYNAMIC_INITIALISE",err,error)
3000  RETURN 1
3001  END SUBROUTINE equations_matrix_dynamic_initialise
3002 
3003  !
3004  !================================================================================================================================
3005  !
3006 
3008  SUBROUTINE equations_matrix_linear_initialise(LINEAR_MATRICES,MATRIX_NUMBER,ERR,ERROR,*)
3009 
3010  !Argument variables
3011  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3012  INTEGER(INTG) :: MATRIX_NUMBER
3013  INTEGER(INTG), INTENT(OUT) :: ERR
3014  TYPE(varying_string), INTENT(OUT) :: ERROR
3015  !Local Variables
3016  INTEGER(INTG) :: DUMMY_ERR
3017  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3018  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
3019  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3020  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3021  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
3022 
3023  enters("EQUATIONS_MATRIX_LINEAR_INITIALISE",err,error,*998)
3024 
3025  IF(ASSOCIATED(linear_matrices)) THEN
3026  IF(matrix_number>0.AND.matrix_number<=linear_matrices%NUMBER_OF_LINEAR_MATRICES) THEN
3027  equations_matrices=>linear_matrices%EQUATIONS_MATRICES
3028  IF(ASSOCIATED(equations_matrices)) THEN
3029  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3030  IF(ASSOCIATED(equations_mapping)) THEN
3031  linear_mapping=>equations_mapping%LINEAR_MAPPING
3032  IF(ASSOCIATED(linear_mapping)) THEN
3033  IF(ASSOCIATED(linear_matrices%MATRICES(matrix_number)%PTR)) THEN
3034  local_error="Equations matrix for linear matrix number "//trim(numbertovstring(matrix_number,"*",err,error))// &
3035  & " is already associated."
3036  CALL flagerror(local_error,err,error,*998)
3037  ELSE
3038  ALLOCATE(linear_matrices%MATRICES(matrix_number)%PTR,stat=err)
3039  IF(err/=0) CALL flagerror("Could not allocate equations matrix.",err,error,*999)
3040  equations_matrix=>linear_matrices%MATRICES(matrix_number)%PTR
3041  equations_matrix%MATRIX_NUMBER=matrix_number
3042  NULLIFY(equations_matrix%DYNAMIC_MATRICES)
3043  equations_matrix%LINEAR_MATRICES=>linear_matrices
3044  equations_matrix%STORAGE_TYPE=matrix_block_storage_type
3045  equations_matrix%STRUCTURE_TYPE=equations_matrix_no_structure
3046  equations_matrix%LUMPED=.false.
3047  equations_matrix%UPDATE_MATRIX=.true.
3048  equations_matrix%FIRST_ASSEMBLY=.true.
3049  equations_matrix%NUMBER_OF_COLUMNS=linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%NUMBER_OF_COLUMNS
3050  linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%EQUATIONS_MATRIX=>equations_matrix
3051  NULLIFY(equations_matrix%MATRIX)
3052  CALL equationsmatrices_elementmatrixinitialise(equations_matrix%ELEMENT_MATRIX,err,error,*999)
3053  CALL equationsmatrices_nodalmatrixinitialise(equations_matrix%NodalMatrix,err,error,*999)
3054  NULLIFY(equations_matrix%TEMP_VECTOR)
3055  ENDIF
3056  ELSE
3057  CALL flagerror("Equations mapping linear mapping is not associated.",err,error,*998)
3058  ENDIF
3059  ELSE
3060  CALL flagerror("Equations mapping is not associated.",err,error,*998)
3061  ENDIF
3062  ELSE
3063  CALL flagerror("Linear matrices equations matrices is not associated.",err,error,*998)
3064  ENDIF
3065  ELSE
3066  local_error="The specified linear matrix number of "//trim(numbertovstring(matrix_number,"*",err,error))// &
3067  & " is invalid. The matrix number must be > 0 and <= "// &
3068  & trim(numbertovstring(linear_matrices%NUMBER_OF_LINEAR_MATRICES,"*",err,error))//"."
3069  CALL flagerror(local_error,err,error,*998)
3070  ENDIF
3071  ELSE
3072  CALL flagerror("Linear matrices is not associated.",err,error,*998)
3073  ENDIF
3074 
3075  exits("EQUATIONS_MATRIX_LINEAR_INITIALISE")
3076  RETURN
3077 999 CALL equations_matrix_finalise(linear_matrices%MATRICES(matrix_number)%PTR,dummy_err,dummy_error,*998)
3078 998 errorsexits("EQUATIONS_MATRIX_LINEAR_INITIALISE",err,error)
3079  RETURN 1
3080  END SUBROUTINE equations_matrix_linear_initialise
3081 
3082  !
3083  !================================================================================================================================
3084  !
3085 
3087  SUBROUTINE equations_matrices_dynamic_finalise(DYNAMIC_MATRICES,ERR,ERROR,*)
3088 
3089  !Argument variables
3090  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
3091  INTEGER(INTG), INTENT(OUT) :: ERR
3092  TYPE(varying_string), INTENT(OUT) :: ERROR
3093  !Local Variables
3094  INTEGER(INTG) :: matrix_idx
3095 
3096  enters("EQUATIONS_MATRICES_DYNAMIC_FINALISE",err,error,*999)
3097 
3098  IF(ASSOCIATED(dynamic_matrices)) THEN
3099  IF(ALLOCATED(dynamic_matrices%MATRICES)) THEN
3100  DO matrix_idx=1,SIZE(dynamic_matrices%MATRICES,1)
3101  CALL equations_matrix_finalise(dynamic_matrices%MATRICES(matrix_idx)%PTR,err,error,*999)
3102  ENDDO !matrix_idx
3103  DEALLOCATE(dynamic_matrices%MATRICES)
3104  ENDIF
3105  IF(ASSOCIATED(dynamic_matrices%TEMP_VECTOR)) CALL distributed_vector_destroy(dynamic_matrices%TEMP_VECTOR,err,error,*999)
3106  DEALLOCATE(dynamic_matrices)
3107  ENDIF
3108 
3109  exits("EQUATIONS_MATRICES_DYNAMIC_FINALISE")
3110  RETURN
3111 999 errorsexits("EQUATIONS_MATRICES_DYNAMIC_FINALISE",err,error)
3112  RETURN 1
3113  END SUBROUTINE equations_matrices_dynamic_finalise
3114 
3115  !
3116  !================================================================================================================================
3117  !
3118 
3120  SUBROUTINE equations_matrices_dynamic_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
3121 
3122  !Argument variables
3123  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3124  INTEGER(INTG), INTENT(OUT) :: ERR
3125  TYPE(varying_string), INTENT(OUT) :: ERROR
3126  !Local Variables
3127  INTEGER(INTG) :: DUMMY_ERR,matrix_idx
3128  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3129  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
3130  TYPE(varying_string) :: DUMMY_ERROR
3131 
3132  enters("EQUATIONS_MATRICES_DYNAMIC_INITIALISE",err,error,*998)
3133 
3134  IF(ASSOCIATED(equations_matrices)) THEN
3135  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3136  IF(ASSOCIATED(equations_mapping)) THEN
3137  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
3138  IF(ASSOCIATED(dynamic_mapping)) THEN
3139  IF(ASSOCIATED(equations_matrices%DYNAMIC_MATRICES)) THEN
3140  CALL flagerror("Equations matrices dynamic matrices is already associated.",err,error,*998)
3141  ELSE
3142  ALLOCATE(equations_matrices%DYNAMIC_MATRICES,stat=err)
3143  IF(err/=0) CALL flagerror("Could not allocate equations matrices dynamic matrices.",err,error,*999)
3144  equations_matrices%DYNAMIC_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3145  equations_matrices%DYNAMIC_MATRICES%NUMBER_OF_DYNAMIC_MATRICES=dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
3146  ALLOCATE(equations_matrices%DYNAMIC_MATRICES%MATRICES(dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES),stat=err)
3147  IF(err/=0) CALL flagerror("Could not allocate equations matrices dynamic matrices matrices.",err,error,*999)
3148  DO matrix_idx=1,dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
3149  NULLIFY(equations_matrices%DYNAMIC_MATRICES%MATRICES(matrix_idx)%PTR)
3150  CALL equations_matrix_dynamic_initialise(equations_matrices%DYNAMIC_MATRICES,matrix_idx,err,error,*999)
3151  ENDDO !matrix_idx
3152  NULLIFY(equations_matrices%DYNAMIC_MATRICES%TEMP_VECTOR)
3153  ENDIF
3154  ENDIF
3155  ELSE
3156  CALL flagerror("Equations matrices equations mapping is not associated.",err,error,*998)
3157  ENDIF
3158  ELSE
3159  CALL flagerror("Equations matrices is not associated.",err,error,*998)
3160  ENDIF
3161 
3162  exits("EQUATIONS_MATRICES_DYNAMIC_INITIALISE")
3163  RETURN
3164 999 CALL equations_matrices_dynamic_finalise(equations_matrices%DYNAMIC_MATRICES,dummy_err,dummy_error,*998)
3165 998 errorsexits("EQUATIONS_MATRICES_DYNAMIC_INITIALISE",err,error)
3166  RETURN 1
3167  END SUBROUTINE equations_matrices_dynamic_initialise
3168 
3169  !
3170  !================================================================================================================================
3171  !
3172 
3174  SUBROUTINE equations_matrices_jacobian_element_add(EQUATIONS_MATRICES,ERR,ERROR,*)
3175 
3176  !Argument variables
3177  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3178  INTEGER(INTG), INTENT(OUT) :: ERR
3179  TYPE(varying_string), INTENT(OUT) :: ERROR
3180  !Local Variables
3181  INTEGER(INTG) :: jacobian_matrix_idx
3182  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
3183  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3184  TYPE(varying_string) :: LOCAL_ERROR
3185 
3186 #ifdef TAUPROF
3187  CALL tau_static_phase_start("EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD()")
3188 #endif
3189 
3190  enters("EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD",err,error,*999)
3191 
3192  IF(ASSOCIATED(equations_matrices)) THEN
3193  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3194  IF(ASSOCIATED(nonlinear_matrices)) THEN
3195  DO jacobian_matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3196  jacobian_matrix=>nonlinear_matrices%JACOBIANS(jacobian_matrix_idx)%PTR
3197  IF(ASSOCIATED(jacobian_matrix)) THEN
3198  IF(jacobian_matrix%UPDATE_JACOBIAN) THEN
3199  !Add in Jacobian element matrices
3200  CALL distributed_matrix_values_add(jacobian_matrix%JACOBIAN,jacobian_matrix%ELEMENT_JACOBIAN%ROW_DOFS(1: &
3201  & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_ROWS),jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS(1: &
3202  & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_COLUMNS),jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1: &
3203  & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_ROWS,1:jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_COLUMNS), &
3204  & err,error,*999)
3205  ENDIF
3206  ELSE
3207  local_error="Jacobian matrix for Jacobian matrix index "// &
3208  & trim(numbertovstring(jacobian_matrix_idx,"*",err,error))//" is not associated."
3209  CALL flagerror(local_error,err,error,*999)
3210  ENDIF
3211  ENDDO !jacobian_matrix_idx
3212  ENDIF
3213  ELSE
3214  CALL flagerror("Equations matrices is not allocated.",err,error,*999)
3215  ENDIF
3216 #ifdef TAUPROF
3217  CALL tau_static_phase_stop("EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD()")
3218 #endif
3219 
3220  exits("EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD")
3221  RETURN
3222 999 errorsexits("EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD",err,error)
3223  RETURN 1
3224  END SUBROUTINE equations_matrices_jacobian_element_add
3225 
3226  !
3227  !================================================================================================================================
3228  !
3229 
3231  SUBROUTINE equations_matrices_jacobian_output(ID,EQUATIONS_MATRICES,ERR,ERROR,*)
3232 
3233  !Argument variables
3234  INTEGER(INTG), INTENT(IN) :: ID
3235  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3236  INTEGER(INTG), INTENT(OUT) :: ERR
3237  TYPE(varying_string), INTENT(OUT) :: ERROR
3238  !Local Variables
3239  INTEGER(INTG) :: jacobian_matrix_idx
3240  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
3241  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3242  TYPE(varying_string) :: LOCAL_ERROR
3243 
3244  enters("EQUATIONS_MATRICES_JACOBIAN_OUTPUT",err,error,*999)
3245 
3246  IF(ASSOCIATED(equations_matrices)) THEN
3247  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3248  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3249  IF(ASSOCIATED(nonlinear_matrices)) THEN
3250  CALL write_string(id,"",err,error,*999)
3251  CALL write_string(id,"Jacobian matrices:",err,error,*999)
3252  DO jacobian_matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3253  jacobian_matrix=>nonlinear_matrices%JACOBIANS(jacobian_matrix_idx)%PTR
3254  IF(ASSOCIATED(jacobian_matrix)) THEN
3255  CALL write_string(id,"Jacobian matrix:",err,error,*999)
3256  CALL distributed_matrix_output(id,jacobian_matrix%JACOBIAN,err,error,*999)
3257  ELSE
3258  local_error="Jacobian matrix for Jacobian matrix index "// &
3259  & trim(numbertovstring(jacobian_matrix_idx,"*",err,error))//" is not associated."
3260  CALL flagerror(local_error,err,error,*999)
3261  ENDIF
3262  ENDDO !jacobian_matrix_idx
3263  ENDIF
3264  ELSE
3265  CALL flagerror("Equations matrices have not been finished.",err,error,*999)
3266  ENDIF
3267  ELSE
3268  CALL flagerror("Equations matrices is not associated.",err,error,*999)
3269  ENDIF
3270 
3271  exits("EQUATIONS_MATRICES_JACOBIAN_OUTPUT")
3272  RETURN
3273 999 errorsexits("EQUATIONS_MATRICES_JACOBIAN_OUTPUT",err,error)
3274  RETURN 1
3275  END SUBROUTINE equations_matrices_jacobian_output
3276 
3277  !
3278  !================================================================================================================================
3279  !
3280 
3282  SUBROUTINE equationsmatrices_jacobiantypesset(equationsMatrices,jacobianTypes,err,error,*)
3283 
3284  !Argument variables
3285  TYPE(equations_matrices_type), POINTER :: equationsMatrices
3286  INTEGER(INTG), INTENT(IN) :: jacobianTypes(:)
3287  INTEGER(INTG), INTENT(OUT) :: err
3288  TYPE(varying_string), INTENT(OUT) :: error
3289  !Local Variables
3290  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
3291  INTEGER(INTG) :: matrixIdx,numberOfjacobians,jacobianType
3292  TYPE(varying_string) :: localError
3293 
3294  enters("EquationsMatrices_JacobianTypesSet",err,error,*999)
3295 
3296  IF(ASSOCIATED(equationsmatrices)) THEN
3297  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
3298  IF(ASSOCIATED(nonlinearmatrices)) THEN
3299  numberofjacobians=SIZE(jacobiantypes,1)
3300  IF(numberofjacobians==nonlinearmatrices%NUMBER_OF_JACOBIANS) THEN
3301  DO matrixidx=1,numberofjacobians
3302  jacobiantype=jacobiantypes(matrixidx)
3303  SELECT CASE(jacobiantype)
3304  CASE(equations_jacobian_finite_difference_calculated, &
3305  & equations_jacobian_analytic_calculated)
3306  nonlinearmatrices%JACOBIANS(matrixidx)%PTR%JACOBIAN_CALCULATION_TYPE=jacobiantype
3307  CASE DEFAULT
3308  localerror="Invalid Jacobian calculation type of " &
3309  & //trim(numbertovstring(jacobiantype,"*",err,error))//"."
3310  CALL flagerror(localerror,err,error,*999)
3311  END SELECT
3312  END DO
3313  ELSE
3314  localerror="Invalid number of Jacobian calculation types. The number of types " &
3315  & //trim(numbertovstring(numberofjacobians,"*",err,error)) &
3316  & //" should be "//trim(numbertovstring(nonlinearmatrices%NUMBER_OF_JACOBIANS,"*",err,error))
3317  CALL flagerror(localerror,err,error,*999)
3318  ENDIF
3319  ELSE
3320  CALL flagerror("Equations matrices nonlinear matrices are not associated",err,error,*999)
3321  ENDIF
3322  ELSE
3323  CALL flagerror("Equations matrices are not associated",err,error,*999)
3324  ENDIF
3325 
3326  exits("EquationsMatrices_JacobianTypesSet")
3327  RETURN
3328 999 errorsexits("EquationsMatrices_JacobianTypesSet",err,error)
3329  RETURN 1
3330  END SUBROUTINE equationsmatrices_jacobiantypesset
3331 
3332  !
3333  !================================================================================================================================
3334  !
3335 
3337  SUBROUTINE equations_matrices_linear_finalise(LINEAR_MATRICES,ERR,ERROR,*)
3338 
3339  !Argument variables
3340  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3341  INTEGER(INTG), INTENT(OUT) :: ERR
3342  TYPE(varying_string), INTENT(OUT) :: ERROR
3343  !Local Variables
3344  INTEGER(INTG) :: matrix_idx
3345 
3346  enters("EQUATIONS_MATRICES_LINEAR_FINALISE",err,error,*999)
3347 
3348  IF(ASSOCIATED(linear_matrices)) THEN
3349  IF(ALLOCATED(linear_matrices%MATRICES)) THEN
3350  DO matrix_idx=1,SIZE(linear_matrices%MATRICES,1)
3351  CALL equations_matrix_finalise(linear_matrices%MATRICES(matrix_idx)%PTR,err,error,*999)
3352  ENDDO !matrix_idx
3353  DEALLOCATE(linear_matrices%MATRICES)
3354  ENDIF
3355  DEALLOCATE(linear_matrices)
3356  ENDIF
3357 
3358  exits("EQUATIONS_MATRICES_LINEAR_FINALISE")
3359  RETURN
3360 999 errorsexits("EQUATIONS_MATRICES_LINEAR_FINALISE",err,error)
3361  RETURN 1
3362  END SUBROUTINE equations_matrices_linear_finalise
3363 
3364  !
3365  !================================================================================================================================
3366  !
3367 
3369  SUBROUTINE equations_matrices_linear_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
3370 
3371  !Argument variables
3372  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3373  INTEGER(INTG), INTENT(OUT) :: ERR
3374  TYPE(varying_string), INTENT(OUT) :: ERROR
3375  !Local Variables
3376  INTEGER(INTG) :: DUMMY_ERR,matrix_idx
3377  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3378  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
3379  TYPE(varying_string) :: DUMMY_ERROR
3380 
3381  enters("EQUATIONS_MATRICES_LINEAR_INITIALISE",err,error,*998)
3382 
3383  IF(ASSOCIATED(equations_matrices)) THEN
3384  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3385  IF(ASSOCIATED(equations_mapping)) THEN
3386  linear_mapping=>equations_mapping%LINEAR_MAPPING
3387  IF(ASSOCIATED(linear_mapping)) THEN
3388  IF(ASSOCIATED(equations_matrices%LINEAR_MATRICES)) THEN
3389  CALL flagerror("Equations matrices linear matrices is already associated.",err,error,*998)
3390  ELSE
3391  ALLOCATE(equations_matrices%LINEAR_MATRICES,stat=err)
3392  IF(err/=0) CALL flagerror("Could not allocate equations matrices linear matrices.",err,error,*999)
3393  equations_matrices%LINEAR_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3394  equations_matrices%LINEAR_MATRICES%NUMBER_OF_LINEAR_MATRICES=linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
3395  ALLOCATE(equations_matrices%LINEAR_MATRICES%MATRICES(linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
3396  IF(err/=0) CALL flagerror("Could not allocate equations matrices linear matrices matrices.",err,error,*999)
3397  DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
3398  NULLIFY(equations_matrices%LINEAR_MATRICES%MATRICES(matrix_idx)%PTR)
3399  CALL equations_matrix_linear_initialise(equations_matrices%LINEAR_MATRICES,matrix_idx,err,error,*999)
3400  ENDDO !matrix_idx
3401  ENDIF
3402  ENDIF
3403  ELSE
3404  CALL flagerror("Equations matrices equations mapping is not associated.",err,error,*998)
3405  ENDIF
3406  ELSE
3407  CALL flagerror("Equations matrices is not associated.",err,error,*998)
3408  ENDIF
3409 
3410  exits("EQUATIONS_MATRICES_LINEAR_INITIALISE")
3411  RETURN
3412 999 CALL equations_matrices_linear_finalise(equations_matrices%LINEAR_MATRICES,dummy_err,dummy_error,*998)
3413 998 errorsexits("EQUATIONS_MATRICES_LINEAR_INITIALISE",err,error)
3414  RETURN 1
3415  END SUBROUTINE equations_matrices_linear_initialise
3416 
3417  !
3418  !================================================================================================================================
3419  !
3420 
3422  SUBROUTINE equations_matrices_nonlinear_finalise(NONLINEAR_MATRICES,ERR,ERROR,*)
3423 
3424  !Argument variables
3425  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3426  INTEGER(INTG), INTENT(OUT) :: ERR
3427  TYPE(varying_string), INTENT(OUT) :: ERROR
3428  !Local Variables
3429  INTEGER(INTG) :: matrix_idx
3430 
3431  enters("EQUATIONS_MATRICES_NONLINEAR_FINALISE",err,error,*999)
3432 
3433  IF(ASSOCIATED(nonlinear_matrices)) THEN
3434  IF(ALLOCATED(nonlinear_matrices%JACOBIANS)) THEN
3435  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3436  CALL equations_jacobian_finalise(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR,err,error,*999)
3437  ENDDO
3438  DEALLOCATE(nonlinear_matrices%JACOBIANS)
3439  ENDIF
3440  IF(ASSOCIATED(nonlinear_matrices%RESIDUAL)) CALL distributed_vector_destroy(nonlinear_matrices%RESIDUAL,err,error,*999)
3441  CALL equations_matrices_element_vector_finalise(nonlinear_matrices%ELEMENT_RESIDUAL,err,error,*999)
3442  CALL equationsmatrices_nodalvectorfinalise(nonlinear_matrices%NodalResidual,err,error,*999)
3443  DEALLOCATE(nonlinear_matrices)
3444  ENDIF
3445 
3446  exits("EQUATIONS_MATRICES_NONLINEAR_FINALISE")
3447  RETURN
3448 999 errorsexits("EQUATIONS_MATRICES_NONLINEAR_FINALISE",err,error)
3449  RETURN 1
3450  END SUBROUTINE equations_matrices_nonlinear_finalise
3451 
3452  !
3453  !================================================================================================================================
3454  !
3455 
3457  SUBROUTINE equations_matrices_nonlinear_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
3458 
3459  !Argument variables
3460  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3461  INTEGER(INTG), INTENT(OUT) :: ERR
3462  TYPE(varying_string), INTENT(OUT) :: ERROR
3463  !Local Variables
3464  INTEGER(INTG) :: matrix_idx,DUMMY_ERR
3465  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3466  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
3467  TYPE(varying_string) :: DUMMY_ERROR
3468 
3469  enters("EQUATIONS_MATRICES_NONLINEAR_INITIALISE",err,error,*998)
3470 
3471  IF(ASSOCIATED(equations_matrices)) THEN
3472  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3473  IF(ASSOCIATED(equations_mapping)) THEN
3474  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
3475  IF(ASSOCIATED(nonlinear_mapping)) THEN
3476  IF(ASSOCIATED(equations_matrices%NONLINEAR_MATRICES)) THEN
3477  CALL flagerror("Equations matrices nonlinear matrices is already associated.",err,error,*998)
3478  ELSE
3479  ALLOCATE(equations_matrices%NONLINEAR_MATRICES,stat=err)
3480  IF(err/=0) CALL flagerror("Could not allocate equations matrices nonlinear matrices.",err,error,*999)
3481  equations_matrices%NONLINEAR_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3482  equations_matrices%NONLINEAR_MATRICES%UPDATE_RESIDUAL=.true.
3483  equations_matrices%NONLINEAR_MATRICES%FIRST_ASSEMBLY=.true.
3484  NULLIFY(equations_matrices%NONLINEAR_MATRICES%RESIDUAL)
3485  CALL equationsmatrices_elementvectorinitialise(equations_matrices%NONLINEAR_MATRICES%ELEMENT_RESIDUAL,err,error,*999)
3486  CALL equationsmatrices_nodalvectorinitialise(equations_matrices%NONLINEAR_MATRICES%NodalResidual,err,error,*999)
3487  equations_matrices%NONLINEAR_MATRICES%NUMBER_OF_JACOBIANS=nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
3488  ALLOCATE(equations_matrices%NONLINEAR_MATRICES%JACOBIANS(nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
3489  IF(err/=0) CALL flagerror("Could not allocate equations matrices Jacobian matrices.",err,error,*999)
3490  DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
3491  NULLIFY(equations_matrices%NONLINEAR_MATRICES%JACOBIANS(matrix_idx)%PTR)
3492  CALL equations_jacobian_initialise(equations_matrices%NONLINEAR_MATRICES,matrix_idx,err,error,*999)
3493  ENDDO !matrix_idx
3494  ENDIF
3495  ENDIF
3496  ELSE
3497  CALL flagerror("Equations matrices equations mapping is not associated.",err,error,*999)
3498  ENDIF
3499  ELSE
3500  CALL flagerror("Equations matrices is not associated.",err,error,*998)
3501  ENDIF
3502 
3503  exits("EQUATIONS_MATRICES_NONLINEAR_INITIALISE")
3504  RETURN
3505 999 CALL equations_matrices_nonlinear_finalise(equations_matrices%NONLINEAR_MATRICES,dummy_err,dummy_error,*998)
3506 998 errorsexits("EQUATIONS_MATRICES_NONLINEAR_INITIALISE",err,error)
3507  RETURN 1
3508  END SUBROUTINE equations_matrices_nonlinear_initialise
3509 
3510  !
3511  !================================================================================================================================
3512  !
3513 
3515  SUBROUTINE equations_matrices_output(ID,EQUATIONS_MATRICES,ERR,ERROR,*)
3516 
3517  !Argument variables
3518  INTEGER(INTG), INTENT(IN) :: ID
3519  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3520  INTEGER(INTG), INTENT(OUT) :: ERR
3521  TYPE(varying_string), INTENT(OUT) :: ERROR
3522  !Local Variables
3523  INTEGER(INTG) :: matrix_idx
3524  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
3525  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3526  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3527  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
3528  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
3529  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3530 
3531  enters("EQUATIONS_MATRICES_OUTPUT",err,error,*999)
3532 
3533  IF(ASSOCIATED(equations_matrices)) THEN
3534  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3535  CALL write_string(id,"",err,error,*999)
3536  CALL write_string(id,"Equations matrices:",err,error,*999)
3537  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3538  IF(ASSOCIATED(dynamic_matrices)) THEN
3539  CALL write_string(id,"Dynamic matrices:",err,error,*999)
3540  CALL write_string_value(id,"Number of dynamic matrices = ",dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,err,error,*999)
3541  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3542  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3543  IF(ASSOCIATED(equations_matrix)) THEN
3544  CALL write_string_value(id,"Equations matrix : ",matrix_idx,err,error,*999)
3545  CALL distributed_matrix_output(id,equations_matrix%MATRIX,err,error,*999)
3546  ELSE
3547  CALL flagerror("Equations matrix is not associated.",err,error,*999)
3548  ENDIF
3549  ENDDO !matrix_idx
3550  ENDIF
3551  linear_matrices=>equations_matrices%LINEAR_MATRICES
3552  IF(ASSOCIATED(linear_matrices)) THEN
3553  CALL write_string(id,"Linear matrices:",err,error,*999)
3554  CALL write_string_value(id,"Number of linear matrices = ",linear_matrices%NUMBER_OF_LINEAR_MATRICES,err,error,*999)
3555  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3556  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
3557  IF(ASSOCIATED(equations_matrix)) THEN
3558  CALL write_string_value(id,"Equations matrix : ",matrix_idx,err,error,*999)
3559  CALL distributed_matrix_output(id,equations_matrix%MATRIX,err,error,*999)
3560  ELSE
3561  CALL flagerror("Equations matrix is not associated.",err,error,*999)
3562  ENDIF
3563  ENDDO !matrix_idx
3564  ENDIF
3565  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3566  IF(ASSOCIATED(nonlinear_matrices)) THEN
3567  CALL write_string(id,"Nonlinear vectors:",err,error,*999)
3568  IF(ASSOCIATED(nonlinear_matrices%RESIDUAL)) THEN
3569  CALL write_string(id,"Residual vector:",err,error,*999)
3570  CALL distributed_vector_output(id,nonlinear_matrices%RESIDUAL,err,error,*999)
3571  ELSE
3572  CALL flagerror("Nonlinear matrices residual is not associated.",err,error,*999)
3573  ENDIF
3574  ENDIF
3575  rhs_vector=>equations_matrices%RHS_VECTOR
3576  IF(ASSOCIATED(rhs_vector)) THEN
3577  CALL write_string(id,"RHS vector:",err,error,*999)
3578  CALL distributed_vector_output(id,rhs_vector%VECTOR,err,error,*999)
3579  ENDIF
3580  source_vector=>equations_matrices%SOURCE_VECTOR
3581  IF(ASSOCIATED(source_vector)) THEN
3582  CALL write_string(id,"Source vector:",err,error,*999)
3583  CALL distributed_vector_output(id,source_vector%VECTOR,err,error,*999)
3584  ENDIF
3585  ELSE
3586  CALL flagerror("Equations matrices have not been finished.",err,error,*999)
3587  ENDIF
3588  ELSE
3589  CALL flagerror("Equations matrices is not associated.",err,error,*999)
3590  ENDIF
3591 
3592  exits("EQUATIONS_MATRICES_OUTPUT")
3593  RETURN
3594 999 errorsexits("EQUATIONS_MATRICES_OUTPUT",err,error)
3595  RETURN 1
3596  END SUBROUTINE equations_matrices_output
3597 
3598  !
3599  !================================================================================================================================
3600  !
3601 
3603  SUBROUTINE equations_matrices_rhs_finalise(RHS_VECTOR,ERR,ERROR,*)
3604 
3605  !Argument variables
3606  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
3607  INTEGER(INTG), INTENT(OUT) :: ERR
3608  TYPE(varying_string), INTENT(OUT) :: ERROR
3609  !Local Variables
3610 
3611  enters("EQUATIONS_MATRICES_RHS_FINALISE",err,error,*999)
3612 
3613  IF(ASSOCIATED(rhs_vector)) THEN
3614  IF(ASSOCIATED(rhs_vector%VECTOR)) CALL distributed_vector_destroy(rhs_vector%VECTOR,err,error,*999)
3615  CALL equations_matrices_element_vector_finalise(rhs_vector%ELEMENT_VECTOR,err,error,*999)
3616  CALL equationsmatrices_nodalvectorfinalise(rhs_vector%NodalVector,err,error,*999)
3617  DEALLOCATE(rhs_vector)
3618  ENDIF
3619 
3620  exits("EQUATIONS_MATRICES_RHS_FINALISE")
3621  RETURN
3622 999 errorsexits("EQUATIONS_MATRICES_RHS_FINALISE",err,error)
3623  RETURN 1
3624  END SUBROUTINE equations_matrices_rhs_finalise
3625 
3626  !
3627  !================================================================================================================================
3628  !
3629 
3631  SUBROUTINE equations_matrices_rhs_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
3632 
3633  !Argument variables
3634  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3635  INTEGER(INTG), INTENT(OUT) :: ERR
3636  TYPE(varying_string), INTENT(OUT) :: ERROR
3637  !Local Variables
3638  INTEGER(INTG) :: DUMMY_ERR
3639  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3640  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
3641  TYPE(varying_string) :: DUMMY_ERROR
3642 
3643  enters("EQUATIONS_MATRICES_RHS_INITIALISE",err,error,*998)
3644 
3645  IF(ASSOCIATED(equations_matrices)) THEN
3646  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3647  IF(ASSOCIATED(equations_mapping)) THEN
3648  rhs_mapping=>equations_mapping%RHS_MAPPING
3649  IF(ASSOCIATED(rhs_mapping)) THEN
3650  IF(ASSOCIATED(equations_matrices%RHS_VECTOR)) THEN
3651  CALL flagerror("Equations matrices RHS vector is already associated.",err,error,*998)
3652  ELSE
3653  ALLOCATE(equations_matrices%RHS_VECTOR,stat=err)
3654  IF(err/=0) CALL flagerror("Could not allocate equations matrices RHS vector.",err,error,*999)
3655  equations_matrices%RHS_VECTOR%UPDATE_VECTOR=.true.
3656  equations_matrices%RHS_VECTOR%FIRST_ASSEMBLY=.true.
3657  NULLIFY(equations_matrices%RHS_VECTOR%VECTOR)
3658  CALL equationsmatrices_elementvectorinitialise(equations_matrices%RHS_VECTOR%ELEMENT_VECTOR,err,error,*999)
3659  CALL equationsmatrices_nodalvectorinitialise(equations_matrices%RHS_VECTOR%NodalVector,err,error,*999)
3660  ENDIF
3661  ENDIF
3662  ELSE
3663  CALL flagerror("Equations matrices equation mapping is not associated.",err,error,*998)
3664  ENDIF
3665  ELSE
3666  CALL flagerror("Equations matrices is not associated.",err,error,*998)
3667  ENDIF
3668 
3669  exits("EQUATIONS_MATRICES_RHS_INITIALISE")
3670  RETURN
3671 999 CALL equations_matrices_rhs_finalise(equations_matrices%RHS_VECTOR,dummy_err,dummy_error,*998)
3672 998 errorsexits("EQUATIONS_MATRICES_RHS_INITIALISE",err,error)
3673  RETURN 1
3674  END SUBROUTINE equations_matrices_rhs_initialise
3675 
3676  !
3677  !================================================================================================================================
3678  !
3679 
3681  SUBROUTINE equations_matrices_source_finalise(SOURCE_VECTOR,ERR,ERROR,*)
3682 
3683  !Argument variables
3684  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
3685  INTEGER(INTG), INTENT(OUT) :: ERR
3686  TYPE(varying_string), INTENT(OUT) :: ERROR
3687  !Local Variables
3688 
3689  enters("EQUATIONS_MATRICES_SOURCE_FINALISE",err,error,*999)
3690 
3691  IF(ASSOCIATED(source_vector)) THEN
3692  IF(ASSOCIATED(source_vector%VECTOR)) CALL distributed_vector_destroy(source_vector%VECTOR,err,error,*999)
3693  CALL equations_matrices_element_vector_finalise(source_vector%ELEMENT_VECTOR,err,error,*999)
3694  CALL equationsmatrices_nodalvectorfinalise(source_vector%NodalVector,err,error,*999)
3695  DEALLOCATE(source_vector)
3696  ENDIF
3697 
3698  exits("EQUATIONS_MATRICES_SOURCE_FINALISE")
3699  RETURN
3700 999 errorsexits("EQUATIONS_MATRICES_SOURCE_FINALISE",err,error)
3701  RETURN 1
3702  END SUBROUTINE equations_matrices_source_finalise
3703 
3704  !
3705  !================================================================================================================================
3706  !
3707 
3709  SUBROUTINE equations_matrices_source_initialise(EQUATIONS_MATRICES,ERR,ERROR,*)
3710 
3711  !Argument variables
3712  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3713  INTEGER(INTG), INTENT(OUT) :: ERR
3714  TYPE(varying_string), INTENT(OUT) :: ERROR
3715  !Local Variables
3716  INTEGER(INTG) :: DUMMY_ERR
3717  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3718  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
3719  TYPE(varying_string) :: DUMMY_ERROR
3720 
3721  enters("EQUATIONS_MATRICES_SOURCE_INITIALISE",err,error,*998)
3722 
3723  IF(ASSOCIATED(equations_matrices)) THEN
3724  equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3725  IF(ASSOCIATED(equations_mapping)) THEN
3726  source_mapping=>equations_mapping%SOURCE_MAPPING
3727  IF(ASSOCIATED(source_mapping)) THEN
3728  IF(ASSOCIATED(equations_matrices%SOURCE_VECTOR)) THEN
3729  CALL flagerror("Equations matrices source vector is already associated.",err,error,*998)
3730  ELSE
3731  ALLOCATE(equations_matrices%SOURCE_VECTOR,stat=err)
3732  IF(err/=0) CALL flagerror("Could not allocate equations matrices source vector.",err,error,*999)
3733  equations_matrices%SOURCE_VECTOR%UPDATE_VECTOR=.true.
3734  equations_matrices%SOURCE_VECTOR%FIRST_ASSEMBLY=.true.
3735  NULLIFY(equations_matrices%SOURCE_VECTOR%VECTOR)
3736  CALL equationsmatrices_elementvectorinitialise(equations_matrices%SOURCE_VECTOR%ELEMENT_VECTOR,err,error,*999)
3737  CALL equationsmatrices_nodalvectorinitialise(equations_matrices%SOURCE_VECTOR%NodalVector,err,error,*999)
3738  ENDIF
3739  ENDIF
3740  ELSE
3741  CALL flagerror("Equations matrices equation mapping is not associated.",err,error,*998)
3742  ENDIF
3743  ELSE
3744  CALL flagerror("Equations matrices is not associated.",err,error,*998)
3745  ENDIF
3746 
3747  exits("EQUATIONS_MATRICES_SOURCE_INITIALISE")
3748  RETURN
3749 999 CALL equations_matrices_source_finalise(equations_matrices%SOURCE_VECTOR,dummy_err,dummy_error,*998)
3750 998 errorsexits("EQUATIONS_MATRICES_SOURCE_INITIALISE",err,error)
3751  RETURN 1
3752  END SUBROUTINE equations_matrices_source_initialise
3753 
3754  !
3755  !================================================================================================================================
3756  !
3757 
3759  SUBROUTINE equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES,LUMPING_TYPE,ERR,ERROR,*)
3760 
3761  !Argument variables
3762  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3763  INTEGER(INTG), INTENT(IN) :: LUMPING_TYPE(:)
3764  INTEGER(INTG), INTENT(OUT) :: ERR
3765  TYPE(varying_string), INTENT(OUT) :: ERROR
3766  !Local Variables
3767  INTEGER(INTG) :: matrix_idx
3768  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
3769  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3770  TYPE(varying_string) :: LOCAL_ERROR
3771 
3772  enters("EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET",err,error,*999)
3773 
3774  IF(ASSOCIATED(equations_matrices)) THEN
3775  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3776  CALL flagerror("Equations matrices have already been finished.",err,error,*999)
3777  ELSE
3778  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3779  IF(ASSOCIATED(dynamic_matrices)) THEN
3780  IF(SIZE(lumping_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES) THEN
3781  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3782  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3783  IF(ASSOCIATED(equations_matrix)) THEN
3784  SELECT CASE(lumping_type(matrix_idx))
3785  CASE(equations_matrix_unlumped)
3786  equations_matrix%LUMPED=.false.
3787  CASE(equations_matrix_lumped)
3788  equations_matrix%LUMPED=.true.
3789  CASE DEFAULT
3790  local_error="The specified lumping type of "//trim(numbertovstring(lumping_type(matrix_idx),"*",err,error))// &
3791  & " for the dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))//" is invalid."
3792  CALL flagerror(local_error,err,error,*999)
3793  END SELECT
3794  ELSE
3795  CALL flagerror("Equations matrix is not associated.",err,error,*999)
3796  ENDIF
3797  ENDDO !matrix_idx
3798  ELSE
3799  local_error="The size of the lumping type array ("//trim(numbertovstring(SIZE(lumping_type,1),"*",err,error))// &
3800  & ") is not equal to the number of dynamic matrices ("// &
3801  & trim(numbertovstring(dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,"*",err,error))//")."
3802  CALL flagerror(local_error,err,error,*999)
3803  ENDIF
3804  ELSE
3805  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
3806  ENDIF
3807  ENDIF
3808  ELSE
3809  CALL flagerror("Equations matrices is not associated.",err,error,*999)
3810  ENDIF
3811 
3812  exits("EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET")
3813  RETURN
3814 999 errorsexits("EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET",err,error)
3815  RETURN 1
3816  END SUBROUTINE equations_matrices_dynamic_lumping_type_set
3817 
3818  !
3819  !================================================================================================================================
3820  !
3821 
3823  SUBROUTINE equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
3824 
3825  !Argument variables
3826  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3827  INTEGER(INTG), INTENT(IN) :: STORAGE_TYPE(:)
3828  INTEGER(INTG), INTENT(OUT) :: ERR
3829  TYPE(varying_string), INTENT(OUT) :: ERROR
3830  !Local Variables
3831  INTEGER(INTG) :: matrix_idx
3832  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
3833  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3834  TYPE(varying_string) :: LOCAL_ERROR
3835 
3836  enters("EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET",err,error,*999)
3837 
3838  IF(ASSOCIATED(equations_matrices)) THEN
3839  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3840  CALL flagerror("Equations matrices have already been finished.",err,error,*999)
3841  ELSE
3842  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3843  IF(ASSOCIATED(dynamic_matrices)) THEN
3844  IF(SIZE(storage_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES) THEN
3845  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3846  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3847  IF(ASSOCIATED(equations_matrix)) THEN
3848  SELECT CASE(storage_type(matrix_idx))
3849  CASE(distributed_matrix_block_storage_type)
3850  equations_matrix%STORAGE_TYPE=distributed_matrix_block_storage_type
3851  CASE(distributed_matrix_diagonal_storage_type)
3852  equations_matrix%STORAGE_TYPE=distributed_matrix_diagonal_storage_type
3853  CASE(distributed_matrix_column_major_storage_type)
3854  equations_matrix%STORAGE_TYPE=distributed_matrix_column_major_storage_type
3855  CASE(distributed_matrix_row_major_storage_type)
3856  equations_matrix%STORAGE_TYPE=distributed_matrix_row_major_storage_type
3857  CASE(distributed_matrix_compressed_row_storage_type)
3858  equations_matrix%STORAGE_TYPE=distributed_matrix_compressed_row_storage_type
3859  CASE(distributed_matrix_compressed_column_storage_type)
3860  equations_matrix%STORAGE_TYPE=distributed_matrix_compressed_column_storage_type
3861  CASE(distributed_matrix_row_column_storage_type)
3862  equations_matrix%STORAGE_TYPE=distributed_matrix_row_column_storage_type
3863  CASE DEFAULT
3864  local_error="The specified storage type of "//trim(numbertovstring(storage_type(matrix_idx),"*",err,error))// &
3865  & " for the dynamic matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))//" is invalid."
3866  CALL flagerror(local_error,err,error,*999)
3867  END SELECT
3868  ELSE
3869  CALL flagerror("Equations matrix is not associated.",err,error,*999)
3870  ENDIF
3871  ENDDO !matrix_idx
3872  ELSE
3873  local_error="The size of the storage type array ("//trim(numbertovstring(SIZE(storage_type,1),"*",err,error))// &
3874  & ") is not equal to the number of dynamic matrices ("// &
3875  & trim(numbertovstring(dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,"*",err,error))//")."
3876  CALL flagerror(local_error,err,error,*999)
3877  ENDIF
3878  ELSE
3879  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
3880  ENDIF
3881  ENDIF
3882  ELSE
3883  CALL flagerror("Equations matrices is not associated.",err,error,*999)
3884  ENDIF
3885 
3886  exits("EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET")
3887  RETURN
3888 999 errorsexits("EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET",err,error)
3889  RETURN 1
3890  END SUBROUTINE equations_matrices_dynamic_storage_type_set
3891 
3892  !
3893  !================================================================================================================================
3894  !
3895 
3897  SUBROUTINE equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
3898 
3899  !Argument variables
3900  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3901  INTEGER(INTG), INTENT(IN) :: STORAGE_TYPE(:)
3902  INTEGER(INTG), INTENT(OUT) :: ERR
3903  TYPE(varying_string), INTENT(OUT) :: ERROR
3904  !Local Variables
3905  INTEGER(INTG) :: matrix_idx
3906  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3907  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3908  TYPE(varying_string) :: LOCAL_ERROR
3909 
3910  enters("EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET",err,error,*999)
3911 
3912  IF(ASSOCIATED(equations_matrices)) THEN
3913  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3914  CALL flagerror("Equations matrices have been finished.",err,error,*999)
3915  ELSE
3916  linear_matrices=>equations_matrices%LINEAR_MATRICES
3917  IF(ASSOCIATED(linear_matrices)) THEN
3918  IF(SIZE(storage_type,1)==linear_matrices%NUMBER_OF_LINEAR_MATRICES) THEN
3919  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3920  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
3921  IF(ASSOCIATED(equations_matrix)) THEN
3922  SELECT CASE(storage_type(matrix_idx))
3923  CASE(distributed_matrix_block_storage_type)
3924  equations_matrix%STORAGE_TYPE=distributed_matrix_block_storage_type
3925  CASE(distributed_matrix_diagonal_storage_type)
3926  equations_matrix%STORAGE_TYPE=distributed_matrix_diagonal_storage_type
3927  CASE(distributed_matrix_column_major_storage_type)
3928  equations_matrix%STORAGE_TYPE=distributed_matrix_column_major_storage_type
3929  CASE(distributed_matrix_row_major_storage_type)
3930  equations_matrix%STORAGE_TYPE=distributed_matrix_row_major_storage_type
3931  CASE(distributed_matrix_compressed_row_storage_type)
3932  equations_matrix%STORAGE_TYPE=distributed_matrix_compressed_row_storage_type
3933  CASE(distributed_matrix_compressed_column_storage_type)
3934  equations_matrix%STORAGE_TYPE=distributed_matrix_compressed_column_storage_type
3935  CASE(distributed_matrix_row_column_storage_type)
3936  equations_matrix%STORAGE_TYPE=distributed_matrix_row_column_storage_type
3937  CASE DEFAULT
3938  local_error="The specified storage type of "//trim(numbertovstring(storage_type(matrix_idx),"*",err,error))// &
3939  & " for the linear matrix number "//trim(numbertovstring(matrix_idx,"*",err,error))//" is invalid."
3940  CALL flagerror(local_error,err,error,*999)
3941  END SELECT
3942  ELSE
3943  CALL flagerror("Equations matrix is not associated.",err,error,*999)
3944  ENDIF
3945  ENDDO !matrix_idx
3946  ELSE
3947  local_error="The size of the storage type array ("//trim(numbertovstring(SIZE(storage_type,1),"*",err,error))// &
3948  & ") is not equal to the number of linear matrices ("// &
3949  & trim(numbertovstring(linear_matrices%NUMBER_OF_LINEAR_MATRICES,"*",err,error))//")."
3950  CALL flagerror(local_error,err,error,*999)
3951  ENDIF
3952  ELSE
3953  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
3954  ENDIF
3955  ENDIF
3956  ELSE
3957  CALL flagerror("Equations matrices is not associated.",err,error,*999)
3958  ENDIF
3959 
3960  exits("EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET")
3961  RETURN
3962 999 errorsexits("EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET",err,error)
3963  RETURN 1
3964  END SUBROUTINE equations_matrices_linear_storage_type_set
3965 
3966  !
3967  !================================================================================================================================
3968  !
3969 
3971  SUBROUTINE equationsmatrices_nonlinearstoragetypeset0(EQUATIONS_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
3972 
3973  !Argument variables
3974  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3975  INTEGER(INTG), INTENT(IN) :: STORAGE_TYPE(:)
3976  INTEGER(INTG), INTENT(OUT) :: ERR
3977  TYPE(varying_string), INTENT(OUT) :: ERROR
3978  !Local Variables
3979  INTEGER(INTG) :: matrix_idx
3980  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
3981  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
3982  TYPE(varying_string) :: LOCAL_ERROR
3983 
3984  enters("EquationsMatrices_NonlinearStorageTypeSet0",err,error,*999)
3985 
3986  IF(ASSOCIATED(equations_matrices)) THEN
3987  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
3988  CALL flagerror("Equations matrices have been finished.",err,error,*999)
3989  ELSE
3990  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3991  IF(ASSOCIATED(nonlinear_matrices)) THEN
3992  IF(SIZE(storage_type,1)==nonlinear_matrices%NUMBER_OF_JACOBIANS) THEN
3993  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3994  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
3995  IF(ASSOCIATED(jacobian_matrix)) THEN
3996  SELECT CASE(storage_type(matrix_idx))
3997  CASE(distributed_matrix_block_storage_type)
3998  jacobian_matrix%STORAGE_TYPE=distributed_matrix_block_storage_type
3999  CASE(distributed_matrix_diagonal_storage_type)
4000  jacobian_matrix%STORAGE_TYPE=distributed_matrix_diagonal_storage_type
4001  CASE(distributed_matrix_column_major_storage_type)
4002  jacobian_matrix%STORAGE_TYPE=distributed_matrix_column_major_storage_type
4003  CASE(distributed_matrix_row_major_storage_type)
4004  jacobian_matrix%STORAGE_TYPE=distributed_matrix_row_major_storage_type
4005  CASE(distributed_matrix_compressed_row_storage_type)
4006  jacobian_matrix%STORAGE_TYPE=distributed_matrix_compressed_row_storage_type
4007  CASE(distributed_matrix_compressed_column_storage_type)
4008  jacobian_matrix%STORAGE_TYPE=distributed_matrix_compressed_column_storage_type
4009  CASE(distributed_matrix_row_column_storage_type)
4010  jacobian_matrix%STORAGE_TYPE=distributed_matrix_row_column_storage_type
4011  CASE DEFAULT
4012  local_error="The specified storage type of "//trim(numbertovstring(storage_type(matrix_idx),"*",err,error))// &
4013  & " for the Jacobian matrix is invalid."
4014  CALL flagerror(local_error,err,error,*999)
4015  END SELECT
4016  ELSE
4017  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
4018  ENDIF
4019  ENDDO
4020  ELSE
4021  local_error="The size of the storage type array ("//trim(numbertovstring(SIZE(storage_type,1),"*",err,error))// &
4022  & ") is not equal to the number of Jacobian matrices ("// &
4023  & trim(numbertovstring(nonlinear_matrices%NUMBER_OF_JACOBIANS,"*",err,error))//")."
4024  CALL flagerror(local_error,err,error,*999)
4025  ENDIF
4026  ELSE
4027  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
4028  ENDIF
4029  ENDIF
4030  ELSE
4031  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4032  ENDIF
4033 
4034  exits("EquationsMatrices_NonlinearStorageTypeSet0")
4035  RETURN
4036 999 errorsexits("EquationsMatrices_NonlinearStorageTypeSet0",err,error)
4037  RETURN 1
4038  END SUBROUTINE equationsmatrices_nonlinearstoragetypeset0
4039 
4040  !
4041  !================================================================================================================================
4042  !
4043 
4045  SUBROUTINE equationsmatrices_nonlinearstoragetypeset1(EQUATIONS_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
4046 
4047  !Argument variables
4048  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4049  INTEGER(INTG), INTENT(IN) :: STORAGE_TYPE
4050  INTEGER(INTG), INTENT(OUT) :: ERR
4051  TYPE(varying_string), INTENT(OUT) :: ERROR
4052  !Local Variables
4053  INTEGER(INTG), ALLOCATABLE :: STORAGE_TYPES(:)
4054  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4055 
4056  enters("EquationsMatrices_NonlinearStorageTypeSet1",err,error,*999)
4057 
4058  IF(ASSOCIATED(equations_matrices)) THEN
4059  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
4060  CALL flagerror("Equations matrices have been finished.",err,error,*999)
4061  ELSE
4062  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4063  IF(ASSOCIATED(nonlinear_matrices)) THEN
4064  ALLOCATE(storage_types(nonlinear_matrices%NUMBER_OF_JACOBIANS),stat=err)
4065  IF(err/=0) CALL flagerror("Could not allocate storage types.",err,error,*999)
4066  storage_types=storage_type
4067  CALL equationsmatrices_nonlinearstoragetypeset0(equations_matrices,storage_types,err,error,*999)
4068  DEALLOCATE(storage_types)
4069  ELSE
4070  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
4071  ENDIF
4072  ENDIF
4073  ELSE
4074  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4075  ENDIF
4076 
4077  exits("EquationsMatrices_NonlinearStorageTypeSet1")
4078  RETURN
4079 999 errorsexits("EquationsMatrices_NonlinearStorageTypeSet1",err,error)
4080  RETURN 1
4081 
4082  END SUBROUTINE equationsmatrices_nonlinearstoragetypeset1
4083 
4084  !
4085  !================================================================================================================================
4086  !
4087 
4089  SUBROUTINE equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES,STRUCTURE_TYPE,ERR,ERROR,*)
4090 
4091  !Argument variables
4092  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4093  INTEGER(INTG), INTENT(IN) :: STRUCTURE_TYPE(:)
4094  INTEGER(INTG), INTENT(OUT) :: ERR
4095  TYPE(varying_string), INTENT(OUT) :: ERROR
4096  !Local Variables
4097  INTEGER(INTG) :: matrix_idx
4098  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
4099  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
4100  TYPE(varying_string) :: LOCAL_ERROR
4101 
4102  enters("EquationsMatrices_DynamicStructureTypeSet",err,error,*999)
4103 
4104  IF(ASSOCIATED(equations_matrices)) THEN
4105  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
4106  CALL flagerror("Equations matrices have been finished.",err,error,*999)
4107  ELSE
4108  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4109  IF(ASSOCIATED(dynamic_matrices)) THEN
4110  IF(SIZE(structure_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES) THEN
4111  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
4112  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
4113  IF(ASSOCIATED(equations_matrix)) THEN
4114  SELECT CASE(structure_type(matrix_idx))
4115  CASE(equations_matrix_no_structure)
4116  equations_matrix%STRUCTURE_TYPE=equations_matrix_no_structure
4117  CASE(equations_matrix_fem_structure)
4118  equations_matrix%STRUCTURE_TYPE=equations_matrix_fem_structure
4119  CASE(equations_matrix_diagonal_structure)
4120  equations_matrix%STRUCTURE_TYPE=equations_matrix_diagonal_structure
4121  CASE(equations_matrix_nodal_structure)
4122  equations_matrix%STRUCTURE_TYPE=equations_matrix_nodal_structure
4123  CASE DEFAULT
4124  local_error="The specified strucutre type of "// &
4125  & trim(numbertovstring(structure_type(matrix_idx),"*",err,error))//" for dynamic matrix number "// &
4126  & trim(numbertovstring(matrix_idx,"*",err,error))//" is invalid."
4127  CALL flagerror(local_error,err,error,*999)
4128  END SELECT
4129  ELSE
4130  CALL flagerror("Equations matrix is not associated.",err,error,*999)
4131  ENDIF
4132  ENDDO !matrix_idx
4133  ELSE
4134  local_error="The size of the structure type array ("//trim(numbertovstring(SIZE(structure_type,1),"*",err,error))// &
4135  & ") is not equal to the number of dynamic matrices ("// &
4136  & trim(numbertovstring(dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,"*",err,error))//")."
4137  CALL flagerror(local_error,err,error,*999)
4138  ENDIF
4139  ELSE
4140  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
4141  ENDIF
4142  ENDIF
4143  ELSE
4144  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4145  ENDIF
4146 
4147  exits("EquationsMatrices_DynamicStructureTypeSet")
4148  RETURN
4149 999 errorsexits("EquationsMatrices_DynamicStructureTypeSet",err,error)
4150  RETURN 1
4151 
4152  END SUBROUTINE equationsmatrices_dynamicstructuretypeset
4153 
4154  !
4155  !================================================================================================================================
4156  !
4157 
4159  SUBROUTINE equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES,STRUCTURE_TYPE,ERR,ERROR,*)
4160 
4161  !Argument variables
4162  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4163  INTEGER(INTG), INTENT(IN) :: STRUCTURE_TYPE(:)
4164  INTEGER(INTG), INTENT(OUT) :: ERR
4165  TYPE(varying_string), INTENT(OUT) :: ERROR
4166  !Local Variables
4167  INTEGER(INTG) :: matrix_idx
4168  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
4169  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
4170  TYPE(varying_string) :: LOCAL_ERROR
4171 
4172  enters("EquationsMatrices_LinearStructureTypeSet",err,error,*999)
4173 
4174  IF(ASSOCIATED(equations_matrices)) THEN
4175  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
4176  CALL flagerror("Equations matrices have been finished.",err,error,*999)
4177  ELSE
4178  linear_matrices=>equations_matrices%LINEAR_MATRICES
4179  IF(ASSOCIATED(linear_matrices)) THEN
4180  IF(SIZE(structure_type,1)==linear_matrices%NUMBER_OF_LINEAR_MATRICES) THEN
4181  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
4182  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
4183  IF(ASSOCIATED(equations_matrix)) THEN
4184  SELECT CASE(structure_type(matrix_idx))
4185  CASE(equations_matrix_no_structure)
4186  equations_matrix%STRUCTURE_TYPE=equations_matrix_no_structure
4187  CASE(equations_matrix_fem_structure)
4188  equations_matrix%STRUCTURE_TYPE=equations_matrix_fem_structure
4189  CASE(equations_matrix_diagonal_structure)
4190  equations_matrix%STRUCTURE_TYPE=equations_matrix_diagonal_structure
4191  CASE(equations_matrix_nodal_structure)
4192  equations_matrix%STRUCTURE_TYPE=equations_matrix_nodal_structure
4193  CASE DEFAULT
4194  local_error="The specified strucutre type of "// &
4195  & trim(numbertovstring(structure_type(matrix_idx),"*",err,error))//" for linear matrix number "// &
4196  & trim(numbertovstring(matrix_idx,"*",err,error))//" is invalid."
4197  CALL flagerror(local_error,err,error,*999)
4198  END SELECT
4199  ELSE
4200  CALL flagerror("Equations matrix is not associated.",err,error,*999)
4201  ENDIF
4202  ENDDO !matrix_idx
4203  ELSE
4204  local_error="The size of the structure type array ("//trim(numbertovstring(SIZE(structure_type,1),"*",err,error))// &
4205  & ") is not equal to the number of linear matrices ("// &
4206  & trim(numbertovstring(linear_matrices%NUMBER_OF_LINEAR_MATRICES,"*",err,error))//")."
4207  CALL flagerror(local_error,err,error,*999)
4208  ENDIF
4209  ELSE
4210  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
4211  ENDIF
4212  ENDIF
4213  ELSE
4214  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4215  ENDIF
4216 
4217  exits("EquationsMatrices_LinearStructureTypeSet")
4218  RETURN
4219 999 errorsexits("EquationsMatrices_LinearStructureTypeSet",err,error)
4220  RETURN 1
4221 
4222  END SUBROUTINE equationsmatrices_linearstructuretypeset
4223 
4224  !
4225  !================================================================================================================================
4226  !
4227 
4229  SUBROUTINE equationsmatrices_nonlinearstructuretypeset0(EQUATIONS_MATRICES,STRUCTURE_TYPE,ERR,ERROR,*)
4230 
4231  !Argument variables
4232  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4233  INTEGER(INTG), INTENT(IN) :: STRUCTURE_TYPE(:)
4234  INTEGER(INTG), INTENT(OUT) :: ERR
4235  TYPE(varying_string), INTENT(OUT) :: ERROR
4236  !Local Variables
4237  INTEGER(INTG) :: matrix_idx
4238  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4239  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
4240  TYPE(varying_string) :: LOCAL_ERROR
4241 
4242  enters("EquationsMatrices_NonlinearStructureTypeSet0",err,error,*999)
4243 
4244  IF(ASSOCIATED(equations_matrices)) THEN
4245  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
4246  CALL flagerror("Equations matrices have been finished.",err,error,*999)
4247  ELSE
4248  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4249  IF(ASSOCIATED(nonlinear_matrices)) THEN
4250  IF(SIZE(structure_type,1)==nonlinear_matrices%NUMBER_OF_JACOBIANS) THEN
4251  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
4252  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
4253  IF(ASSOCIATED(jacobian_matrix)) THEN
4254  SELECT CASE(structure_type(matrix_idx))
4255  CASE(equations_matrix_no_structure)
4256  jacobian_matrix%STRUCTURE_TYPE=equations_matrix_no_structure
4257  CASE(equations_matrix_fem_structure)
4258  jacobian_matrix%STRUCTURE_TYPE=equations_matrix_fem_structure
4259  CASE(equations_matrix_diagonal_structure)
4260  jacobian_matrix%STRUCTURE_TYPE=equations_matrix_diagonal_structure
4261  CASE(equations_matrix_nodal_structure)
4262  jacobian_matrix%STRUCTURE_TYPE=equations_matrix_nodal_structure
4263  CASE DEFAULT
4264  local_error="The specified strucutre type of "// &
4265  & trim(numbertovstring(structure_type(matrix_idx),"*",err,error))//" for the Jacobian matrix is invalid."
4266  CALL flagerror(local_error,err,error,*999)
4267  END SELECT
4268  ELSE
4269  CALL flagerror("Equations matrix is not associated.",err,error,*999)
4270  ENDIF
4271  ENDDO
4272  ELSE
4273  local_error="The size of the structure type array ("//trim(numbertovstring(SIZE(structure_type,1),"*",err,error))// &
4274  & ") is not equal to the number of Jacobian matrices ("// &
4275  & trim(numbertovstring(nonlinear_matrices%NUMBER_OF_JACOBIANS,"*",err,error))//")."
4276  CALL flagerror(local_error,err,error,*999)
4277  ENDIF
4278  ELSE
4279  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
4280  ENDIF
4281  ENDIF
4282  ELSE
4283  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4284  ENDIF
4285 
4286  exits("EquationsMatrices_NonlinearStructureTypeSet0")
4287  RETURN
4288 999 errors("EquationsMatrices_NonlinearStructureTypeSet0",err,error)
4289  exits("EquationsMatrices_NonlinearStructureTypeSet0")
4290  RETURN 1
4291 
4292  END SUBROUTINE equationsmatrices_nonlinearstructuretypeset0
4293 
4294  !
4295  !================================================================================================================================
4296  !
4297 
4299  SUBROUTINE equationsmatrices_nonlinearstructuretypeset1(EQUATIONS_MATRICES,STRUCTURE_TYPE,ERR,ERROR,*)
4300 
4301  !Argument variables
4302  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4303  INTEGER(INTG), INTENT(IN) :: STRUCTURE_TYPE
4304  INTEGER(INTG), INTENT(OUT) :: ERR
4305  TYPE(varying_string), INTENT(OUT) :: ERROR
4306  !Local Variables
4307  INTEGER(INTG), ALLOCATABLE :: STRUCTURE_TYPES(:)
4308  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4309 
4310  enters("EquationsMatrices_NonlinearStructureTypeSet1",err,error,*999)
4311 
4312  IF(ASSOCIATED(equations_matrices)) THEN
4313  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
4314  CALL flagerror("Equations matrices have been finished.",err,error,*999)
4315  ELSE
4316  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4317  IF(ASSOCIATED(nonlinear_matrices)) THEN
4318  ALLOCATE(structure_types(nonlinear_matrices%NUMBER_OF_JACOBIANS),stat=err)
4319  IF(err/=0) CALL flagerror("Could not allocate storage types.",err,error,*999)
4320  structure_types=structure_type
4321  CALL equationsmatrices_nonlinearstructuretypeset0(equations_matrices,structure_types,err,error,*999)
4322  DEALLOCATE(structure_types)
4323  ELSE
4324  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
4325  ENDIF
4326  ENDIF
4327  ELSE
4328  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4329  ENDIF
4330 
4331  exits("EquationsMatrices_NonlinearStructureTypeSet1")
4332  RETURN
4333 999 errors("EquationsMatrices_NonlinearStructureTypeSet1",err,error)
4334  exits("EquationsMatrices_NonlinearStructureTypeSet1")
4335  RETURN 1
4336 
4337  END SUBROUTINE equationsmatrices_nonlinearstructuretypeset1
4338 
4339  !
4340  !================================================================================================================================
4341  !
4342 
4344  SUBROUTINE equations_matrices_finalise(EQUATIONS_MATRICES,ERR,ERROR,*)
4345 
4346  !Argument variables
4347  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4348  INTEGER(INTG), INTENT(OUT) :: ERR
4349  TYPE(varying_string), INTENT(OUT) :: ERROR
4350  !Local Variables
4351 
4352  enters("EQUATIONS_MATRICES_FINALISE",err,error,*999)
4353 
4354  IF(ASSOCIATED(equations_matrices)) THEN
4355  CALL equations_matrices_dynamic_finalise(equations_matrices%DYNAMIC_MATRICES,err,error,*999)
4356  CALL equations_matrices_linear_finalise(equations_matrices%LINEAR_MATRICES,err,error,*999)
4357  CALL equations_matrices_nonlinear_finalise(equations_matrices%NONLINEAR_MATRICES,err,error,*999)
4358  CALL equations_matrices_rhs_finalise(equations_matrices%RHS_VECTOR,err,error,*999)
4359  CALL equations_matrices_source_finalise(equations_matrices%SOURCE_VECTOR,err,error,*999)
4360  DEALLOCATE(equations_matrices)
4361  ENDIF
4362 
4363  exits("EQUATIONS_MATRICES_FINALISE")
4364  RETURN
4365 999 errorsexits("EQUATIONS_MATRICES_FINALISE",err,error)
4366  RETURN 1
4367  END SUBROUTINE equations_matrices_finalise
4368 
4369  !
4370  !================================================================================================================================
4371  !
4372 
4374  SUBROUTINE equations_matrices_initialise(EQUATIONS,ERR,ERROR,*)
4375 
4376  !Argument variables
4377  TYPE(equations_type), POINTER :: EQUATIONS
4378  INTEGER(INTG), INTENT(OUT) :: ERR
4379  TYPE(varying_string), INTENT(OUT) :: ERROR
4380  !Local Variables
4381  INTEGER(INTG) :: DUMMY_ERR
4382  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
4383  TYPE(varying_string) :: DUMMY_ERROR
4384 
4385  enters("EQUATIONS_MATRICES_INITIALISE",err,error,*998)
4386 
4387  IF(ASSOCIATED(equations)) THEN
4388  IF(ASSOCIATED(equations%EQUATIONS_MATRICES)) THEN
4389  CALL flagerror("Equations matrices is already associated for this equations.",err,error,*998)
4390  ELSE
4391  equations_mapping=>equations%EQUATIONS_MAPPING
4392  IF(ASSOCIATED(equations_mapping)) THEN
4393  IF(equations_mapping%EQUATIONS_MAPPING_FINISHED) THEN
4394  ALLOCATE(equations%EQUATIONS_MATRICES,stat=err)
4395  IF(err/=0) CALL flagerror("Could not allocate equations equations matrices.",err,error,*999)
4396  equations%EQUATIONS_MATRICES%EQUATIONS=>equations
4397  equations%EQUATIONS_MATRICES%EQUATIONS_MATRICES_FINISHED=.false.
4398  equations%EQUATIONS_MATRICES%EQUATIONS_MAPPING=>equations_mapping
4399  NULLIFY(equations%EQUATIONS_MATRICES%SOLVER_MAPPING)
4400  equations%EQUATIONS_MATRICES%NUMBER_OF_ROWS=equations_mapping%NUMBER_OF_ROWS
4401  equations%EQUATIONS_MATRICES%TOTAL_NUMBER_OF_ROWS=equations_mapping%TOTAL_NUMBER_OF_ROWS
4402  equations%EQUATIONS_MATRICES%NUMBER_OF_GLOBAL_ROWS=equations_mapping%NUMBER_OF_GLOBAL_ROWS
4403  NULLIFY(equations%EQUATIONS_MATRICES%DYNAMIC_MATRICES)
4404  NULLIFY(equations%EQUATIONS_MATRICES%LINEAR_MATRICES)
4405  NULLIFY(equations%EQUATIONS_MATRICES%NONLINEAR_MATRICES)
4406  NULLIFY(equations%EQUATIONS_MATRICES%RHS_VECTOR)
4407  NULLIFY(equations%EQUATIONS_MATRICES%SOURCE_VECTOR)
4408  CALL equations_matrices_dynamic_initialise(equations%EQUATIONS_MATRICES,err,error,*999)
4409  CALL equations_matrices_linear_initialise(equations%EQUATIONS_MATRICES,err,error,*999)
4410  CALL equations_matrices_nonlinear_initialise(equations%EQUATIONS_MATRICES,err,error,*999)
4411  CALL equations_matrices_rhs_initialise(equations%EQUATIONS_MATRICES,err,error,*999)
4412  CALL equations_matrices_source_initialise(equations%EQUATIONS_MATRICES,err,error,*999)
4413  ELSE
4414  CALL flagerror("Equations mapping has not been finished.",err,error,*999)
4415  ENDIF
4416  ELSE
4417  CALL flagerror("Equations equations mapping is not associated.",err,error,*998)
4418  ENDIF
4419  ENDIF
4420  ELSE
4421  CALL flagerror("Equations is not associated.",err,error,*998)
4422  ENDIF
4423 
4424  exits("EQUATIONS_MATRICES_INITIALISE")
4425  RETURN
4426 999 CALL equations_matrices_finalise(equations%EQUATIONS_MATRICES,dummy_err,dummy_error,*998)
4427 998 errorsexits("EQUATIONS_MATRICES_INITIALISE",err,error)
4428  RETURN 1
4429  END SUBROUTINE equations_matrices_initialise
4430 
4431  !
4432  !================================================================================================================================
4433  !
4434 
4436  SUBROUTINE equations_matrices_values_initialise(EQUATIONS_MATRICES,SELECTION_TYPE,VALUE,ERR,ERROR,*)
4437 
4438  !Argument variables
4439  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4440  INTEGER(INTG), INTENT(IN) :: SELECTION_TYPE
4441  REAL(DP), INTENT(IN) :: VALUE
4442  INTEGER(INTG), INTENT(OUT) :: ERR
4443  TYPE(varying_string), INTENT(OUT) :: ERROR
4444  !Local Variables
4445  INTEGER(INTG) :: matrix_idx
4446  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
4447  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
4448  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
4449  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4450  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
4451  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
4452  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
4453 
4454  enters("EQUATIONS_MATRICES_VALUES_INITIALISE",err,error,*999)
4455 
4456  IF(ASSOCIATED(equations_matrices)) THEN
4457  IF(selection_type==equations_matrices_all.OR. &
4458  & selection_type==equations_matrices_dynamic_only.OR. &
4459  & selection_type==equations_matrices_linear_only.OR. &
4460  & selection_type==equations_matrices_nonlinear_only) THEN
4461  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4462  IF(ASSOCIATED(dynamic_matrices)) THEN
4463  DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
4464  equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
4465  IF(ASSOCIATED(equations_matrix)) THEN
4466  IF(equations_matrix%UPDATE_MATRIX) THEN
4467  CALL distributed_matrix_all_values_set(equations_matrix%MATRIX,VALUE,err,error,*999)
4468  ENDIF
4469  ELSE
4470  CALL flagerror("Equations matrix is not associated.",err,error,*999)
4471  ENDIF
4472  ENDDO !matrix_idx
4473  ENDIF
4474  ENDIF
4475  IF(selection_type==equations_matrices_all.OR. &
4476  & selection_type==equations_matrices_dynamic_only.OR. &
4477  & selection_type==equations_matrices_linear_only.OR. &
4478  & selection_type==equations_matrices_nonlinear_only) THEN
4479  linear_matrices=>equations_matrices%LINEAR_MATRICES
4480  IF(ASSOCIATED(linear_matrices)) THEN
4481  DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
4482  equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
4483  IF(ASSOCIATED(equations_matrix)) THEN
4484  IF(equations_matrix%UPDATE_MATRIX) THEN
4485  CALL distributed_matrix_all_values_set(equations_matrix%MATRIX,VALUE,err,error,*999)
4486  ENDIF
4487  ELSE
4488  CALL flagerror("Equations matrix is not associated.",err,error,*999)
4489  ENDIF
4490  ENDDO !matrix_idx
4491  ENDIF
4492  ENDIF
4493  IF(selection_type==equations_matrices_all.OR. &
4494  & selection_type==equations_matrices_nonlinear_only.OR. &
4495  & selection_type==equations_matrices_jacobian_only) THEN
4496  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4497  IF(ASSOCIATED(nonlinear_matrices)) THEN
4498  DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
4499  jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
4500  IF(ASSOCIATED(jacobian_matrix)) THEN
4501  IF(jacobian_matrix%UPDATE_JACOBIAN) THEN
4502  CALL distributed_matrix_all_values_set(jacobian_matrix%JACOBIAN,VALUE,err,error,*999)
4503  ENDIF
4504  ELSE
4505  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
4506  ENDIF
4507  ENDDO
4508  ENDIF
4509  ENDIF
4510  IF(selection_type==equations_matrices_all.OR. &
4511  & selection_type==equations_matrices_nonlinear_only.OR. &
4512  & selection_type==equations_matrices_residual_only.OR. &
4513  & selection_type==equations_matrices_rhs_residual_only.OR. &
4514  & selection_type==equations_matrices_residual_source_only.OR. &
4515  & selection_type==equations_matrices_vectors_only) THEN
4516  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4517  IF(ASSOCIATED(nonlinear_matrices)) THEN
4518  IF(nonlinear_matrices%UPDATE_RESIDUAL) THEN
4519  CALL distributed_vector_all_values_set(nonlinear_matrices%RESIDUAL,VALUE,err,error,*999)
4520  ENDIF
4521  ENDIF
4522  ENDIF
4523  IF(selection_type==equations_matrices_all.OR. &
4524  & selection_type==equations_matrices_dynamic_only.OR. &
4525  & selection_type==equations_matrices_linear_only.OR. &
4526  & selection_type==equations_matrices_nonlinear_only.OR. &
4527  & selection_type==equations_matrices_rhs_only.OR. &
4528  & selection_type==equations_matrices_rhs_residual_only.OR. &
4529  & selection_type==equations_matrices_rhs_source_only.OR. &
4530  & selection_type==equations_matrices_vectors_only) THEN
4531  rhs_vector=>equations_matrices%RHS_VECTOR
4532  IF(ASSOCIATED(rhs_vector)) THEN
4533  IF(rhs_vector%UPDATE_VECTOR) THEN
4534  CALL distributed_vector_all_values_set(rhs_vector%VECTOR,VALUE,err,error,*999)
4535  ENDIF
4536  ENDIF
4537  ENDIF
4538  IF(selection_type==equations_matrices_all.OR. &
4539  & selection_type==equations_matrices_dynamic_only.OR. &
4540  & selection_type==equations_matrices_linear_only.OR. &
4541  & selection_type==equations_matrices_nonlinear_only.OR. &
4542  & selection_type==equations_matrices_source_only.OR. &
4543  & selection_type==equations_matrices_rhs_source_only.OR. &
4544  & selection_type==equations_matrices_residual_source_only.OR. &
4545  & selection_type==equations_matrices_vectors_only) THEN
4546  source_vector=>equations_matrices%SOURCE_VECTOR
4547  IF(ASSOCIATED(source_vector)) THEN
4548  IF(source_vector%UPDATE_VECTOR) THEN
4549  CALL distributed_vector_all_values_set(source_vector%VECTOR,VALUE,err,error,*999)
4550  ENDIF
4551  ENDIF
4552  ENDIF
4553  ELSE
4554  CALL flagerror("Equations matrices is not associated.",err,error,*999)
4555  ENDIF
4556 
4557  exits("EQUATIONS_MATRICES_VALUES_INITIALISE")
4558  RETURN
4559 999 errorsexits("EQUATIONS_MATRICES_VALUES_INITIALISE",err,error)
4560  RETURN 1
4561  END SUBROUTINE equations_matrices_values_initialise
4562 
4563  !
4564  !================================================================================================================================
4565  !
4566 
4568  SUBROUTINE equationsmatrix_structurecalculate(equationsMatrix,numberOfNonZeros,rowIndices,columnIndices,list,err,error,*)
4569 
4570  !Argument variables
4571  TYPE(equations_matrix_type), POINTER :: equationsMatrix
4572  INTEGER(INTG), INTENT(OUT) :: numberOfNonZeros
4573  INTEGER(INTG), POINTER :: rowIndices(:)
4574  INTEGER(INTG), POINTER :: columnIndices(:)
4575  type(linkedlist),pointer :: list(:)
4576  INTEGER(INTG), INTENT(OUT) :: err
4577  TYPE(varying_string), INTENT(OUT) :: error
4578  !Local Variables
4579  INTEGER(INTG) :: columnIdx,dummyErr,elementIdx,globalColumn,localColumn,local_ny,matrixNumber,mk,mp,ne,nh,nh2,nn,nnk,np
4580  INTEGER(INTG) :: numberOfColumns,nyy,nyyg,npg,nhg,local_cols,local_dof,mv
4581  INTEGER(INTG) :: dofIdx,nodeIdx,componentIdx,localDofIdx
4582  INTEGER(INTG) :: versionIdx,derivativeIdx,numberOfDerivatives,numberOfVersions
4583  INTEGER(INTG), ALLOCATABLE :: columns(:)
4584  REAL(DP) :: sparsity
4585  TYPE(basis_type), POINTER :: basis
4586  TYPE(domain_mapping_type), POINTER :: dependentDofsDomainMapping
4587  TYPE(domain_elements_type), POINTER :: domainElements
4588  TYPE(domain_nodes_type), POINTER :: domainNodes
4589  TYPE(equations_type), POINTER :: equations
4590  TYPE(equations_mapping_type), POINTER :: equationsMapping
4591  TYPE(equations_mapping_dynamic_type), POINTER :: dynamicMapping
4592  TYPE(equations_mapping_linear_type), POINTER :: linearMapping
4593  TYPE(equations_matrices_type), POINTER :: equationsMatrices
4594  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
4595  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
4596  TYPE(equations_set_type), POINTER :: equationsSet
4597  TYPE(field_type), POINTER :: dependentField
4598  TYPE(field_dof_to_param_map_type), POINTER :: dependentDofsParamMapping
4599  TYPE(field_variable_type), POINTER :: fieldVariable
4600  TYPE(list_ptr_type), ALLOCATABLE :: columnIndicesLists(:)
4601  TYPE(varying_string) :: dummyError,localError
4602  enters("EquationsMatrix_StructureCalculate",err,error,*998)
4603 
4604  numberofnonzeros=0
4605  IF(ASSOCIATED(equationsmatrix)) THEN
4606  IF(.NOT.ASSOCIATED(rowindices)) THEN
4607  IF(.NOT.ASSOCIATED(columnindices)) THEN
4608  matrixnumber=equationsmatrix%MATRIX_NUMBER
4609  SELECT CASE(equationsmatrix%STRUCTURE_TYPE)
4610  CASE(equations_matrix_no_structure)
4611  CALL flagerror("There is no structure to calculate for a matrix with no structure.",err,error,*998)
4612  CASE(equations_matrix_fem_structure)
4613  SELECT CASE(equationsmatrix%STORAGE_TYPE)
4614  CASE(matrix_compressed_row_storage_type)
4615  linearmatrices=>equationsmatrix%LINEAR_MATRICES
4616  dynamicmatrices=>equationsmatrix%DYNAMIC_MATRICES
4617  IF(ASSOCIATED(dynamicmatrices).OR.ASSOCIATED(linearmatrices)) THEN
4618  IF(ASSOCIATED(dynamicmatrices)) THEN
4619  equationsmatrices=>dynamicmatrices%EQUATIONS_MATRICES
4620  ELSE
4621  equationsmatrices=>linearmatrices%EQUATIONS_MATRICES
4622  ENDIF
4623  IF(ASSOCIATED(equationsmatrices)) THEN
4624  equations=>equationsmatrices%EQUATIONS
4625  IF(ASSOCIATED(equations)) THEN
4626  equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
4627  IF(ASSOCIATED(equationsmapping)) THEN
4628  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
4629  linearmapping=>equationsmapping%LINEAR_MAPPING
4630  IF(ASSOCIATED(dynamicmapping).OR.ASSOCIATED(linearmapping)) THEN
4631  equationsset=>equations%EQUATIONS_SET
4632  IF(ASSOCIATED(equationsset)) THEN
4633  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
4634  IF(ASSOCIATED(dependentfield)) THEN
4635  IF(ASSOCIATED(dynamicmatrices)) THEN
4636  fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4637  ELSE
4638  fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4639  ENDIF
4640  IF(ASSOCIATED(fieldvariable)) THEN
4641  dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
4642  IF(ASSOCIATED(dependentdofsdomainmapping)) THEN
4643  dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
4644  IF(ASSOCIATED(dependentdofsparammapping)) THEN
4645  !Allocate lists
4646  ALLOCATE(columnindiceslists(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
4647  IF(err/=0) CALL flagerror("Could not allocate column indices lists.",err,error,*999)
4648  !Allocate row indices
4649  ALLOCATE(rowindices(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
4650  IF(err/=0) CALL flagerror("Could not allocate row indices.",err,error,*999)
4651  rowindices(1)=1
4652 
4653  !First, loop over the rows and calculate the number of non-zeros
4654  numberofnonzeros=0
4655  DO local_ny=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4656  IF(dependentdofsparammapping%DOF_TYPE(1,local_ny)==field_node_dof_type) THEN
4657  nyy=dependentdofsparammapping%DOF_TYPE(2,local_ny)!value for a particular field dof (local_ny)
4658  np=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyy)!node number (np) of the field parameter
4659  nh=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyy)!component number (nh) of the field parameter
4660  domainnodes=>fieldvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%NODES
4661 
4662  !Set up list
4663  NULLIFY(columnindiceslists(local_ny)%PTR)
4664  CALL list_create_start(columnindiceslists(local_ny)%PTR,err,error,*999)
4665  CALL list_data_type_set(columnindiceslists(local_ny)%PTR,list_intg_type,err,error,*999)
4666  CALL list_initial_size_set(columnindiceslists(local_ny)%PTR,domainnodes%NODES(np)% &
4667  & number_of_surrounding_elements*fieldvariable%COMPONENTS(nh)% &
4668  & maxnumberelementinterpolationparameters,err,error,*999)
4669  CALL list_create_finish(columnindiceslists(local_ny)%PTR,err,error,*999)
4670  !Loop over all elements containing the dof
4671  DO elementidx=1,domainnodes%NODES(np)%NUMBER_OF_SURROUNDING_ELEMENTS
4672  ne=domainnodes%NODES(np)%SURROUNDING_ELEMENTS(elementidx)
4673  DO nh2=1,fieldvariable%NUMBER_OF_COMPONENTS
4674  domainelements=>fieldvariable%COMPONENTS(nh2)%DOMAIN%TOPOLOGY%ELEMENTS
4675  basis=>domainelements%ELEMENTS(ne)%BASIS
4676  DO nn=1,basis%NUMBER_OF_NODES
4677  mp=domainelements%ELEMENTS(ne)%ELEMENT_NODES(nn)
4678  DO nnk=1,basis%NUMBER_OF_DERIVATIVES(nn)
4679  mk=domainelements%ELEMENTS(ne)%ELEMENT_DERIVATIVES(nnk,nn)
4680  mv=domainelements%ELEMENTS(ne)%elementVersions(nnk,nn)
4681  !Find the local and global column and add the global column to the indices list
4682  localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
4683  & nodes(mp)%DERIVATIVES(mk)%VERSIONS(mv)
4684  globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
4685 
4686  CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn,err,error,*999)
4687 
4688  ENDDO !mk
4689  ENDDO !nn
4690  ENDDO !nh2
4691  ENDDO !elementIdx
4692  CALL list_remove_duplicates(columnindiceslists(local_ny)%PTR,err,error,*999)
4693  CALL list_number_of_items_get(columnindiceslists(local_ny)%PTR,numberofcolumns, &
4694  & err,error,*999)
4695  numberofnonzeros=numberofnonzeros+numberofcolumns
4696  rowindices(local_ny+1)=numberofnonzeros+1
4697  ELSE
4698  localerror="Local dof number "//trim(numbertovstring(local_ny,"*",err,error))// &
4699  & " is not a node based dof."
4700  CALL flagerror(localerror,err,error,*999)
4701  ENDIF
4702  ENDDO !local_ny
4703 
4704 
4705  !Allocate and setup the column locations
4706  ALLOCATE(columnindices(numberofnonzeros),stat=err)
4707 
4708  ALLOCATE(list(dependentdofsdomainmapping%NUMBER_OF_GLOBAL))
4709 
4710  IF(err/=0) CALL flagerror("Could not allocate column indices.",err,error,*999)
4711  DO local_ny=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4712 
4713  CALL list_detach_and_destroy(columnindiceslists(local_ny)%PTR,numberofcolumns,columns, &
4714  & err,error,*999)
4715  DO columnidx=1,numberofcolumns
4716  !COLUMNS store the list of nonzero column indices for each local row (local_ny)
4717  columnindices(rowindices(local_ny)+columnidx-1)=columns(columnidx)
4718 
4719  ! global to local columns
4720  IF(ASSOCIATED(linearmapping).OR.ASSOCIATED(dynamicmapping)) THEN
4721  IF(ASSOCIATED(dynamicmatrices)) THEN
4722  local_cols=equationsmatrices%equations_mapping%dynamic_mapping &
4723  & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4724  & (columns(columnidx))%LOCAL_NUMBER(1)
4725  local_dof = local_cols
4726  ! Column to dof mapping?
4727  !local_dof=equationsMatrices%equations_mapping%dynamic_mapping% &
4728  ! & equations_matrix_to_var_maps(1)%column_to_dof_map(local_cols)
4729  ELSE
4730  local_cols=equationsmatrices%equations_mapping%linear_mapping &
4731  & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4732  & (columns(columnidx))%LOCAL_NUMBER(1)
4733  local_dof = local_cols
4734  ENDIF
4735  ENDIF
4736  nyyg=dependentdofsparammapping%DOF_TYPE(2,local_dof)
4737  npg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyyg)
4738  nhg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyyg)
4739  domainnodes=>fieldvariable%COMPONENTS(nhg)%DOMAIN%TOPOLOGY%NODES
4740 
4741  ! Check whether boundary node
4742  IF(domainnodes%NODES(npg)%BOUNDARY_NODE)THEN
4743  CALL linkedlist_add(list(columns(columnidx)),local_ny,err,error,*999)
4744  ENDIF
4745 
4746  ENDDO !columnIdx
4747  DEALLOCATE(columns)
4748  ENDDO !local_ny
4749 
4750 
4751  IF(diagnostics1) THEN
4752  CALL write_string(diagnostic_output_type,"Equations matrix structure:",err,error,*999)
4753  CALL write_string_value(diagnostic_output_type,"Equations matrix number : ",matrixnumber, &
4754  & err,error,*999)
4755  CALL write_string_value(diagnostic_output_type," Number of rows = ", &
4756  & dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL,err,error,*999)
4757  CALL write_string_value(diagnostic_output_type," Number of columns = ", &
4758  & dependentdofsdomainmapping%NUMBER_OF_GLOBAL,err,error,*999)
4759  CALL write_string_value(diagnostic_output_type," Number of non zeros = ", &
4760  & numberofnonzeros,err,error,*999)
4761  IF(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL* &
4762  & dependentdofsdomainmapping%NUMBER_OF_GLOBAL/=0) THEN
4763  sparsity=(1.0_dp-REAL(numberofnonzeros,dp)/REAL(dependentdofsdomainmapping% &
4764  & TOTAL_NUMBER_OF_LOCAL*dependentDofsDomainMapping%NUMBER_OF_GLOBAL,DP))*100.0_DP
4765  CALL WRITE_STRING_FMT_VALUE(diagnostic_output_type," Sparsity (% of zeros) = ", &
4766  & sparsity,"F6.2",err,error,*999)
4767  ENDIF
4768  CALL write_string_vector(diagnostic_output_type,1,1,dependentdofsdomainmapping% &
4769  & total_number_of_local+1,8,8,rowindices,'(" Row indices :",8(X,I13))', &
4770  & '(18X,8(X,I13))',err,error,*999)
4771  CALL write_string_vector(diagnostic_output_type,1,1,numberofnonzeros,8,8,columnindices, &
4772  & '(" Column indices :",8(X,I13))','(18X,8(X,I13))', err,error,*999)
4773  ENDIF
4774  ELSE
4775  CALL flagerror("Dependent dofs parameter mapping is not associated.",err,error,*999)
4776  ENDIF
4777  ELSE
4778  CALL flagerror("Dependent dofs domain mapping is not associated.",err,error,*999)
4779  ENDIF
4780  ELSE
4781  CALL flagerror("Dependent field variable is not associated.",err,error,*999)
4782  ENDIF
4783  ELSE
4784  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
4785  ENDIF
4786  ELSE
4787  CALL flagerror("Equations set is not associated.",err,error,*999)
4788  ENDIF
4789  ELSE
4790  CALL flagerror("Either equations mapping dynamic mapping or linear mapping is not associated.", &
4791  & err,error,*999)
4792  ENDIF
4793  ELSE
4794  CALL flagerror("Equations mapping is not associated.",err,error,*999)
4795  ENDIF
4796  ELSE
4797  CALL flagerror("Equations is not associated.",err,error,*999)
4798  ENDIF
4799  ELSE
4800  CALL flagerror("Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
4801  ENDIF
4802  ELSE
4803  CALL flagerror("Either equations matrix dynamic or linear matrices is not associated.",err,error,*999)
4804  ENDIF
4805  CASE DEFAULT
4806  localerror="The matrix storage type of "// &
4807  & trim(numbertovstring(equationsmatrix%STORAGE_TYPE,"*",err,error))//" is invalid."
4808  CALL flagerror(localerror,err,error,*999)
4809  END SELECT
4810 
4811  CASE(equations_matrix_nodal_structure)
4812  SELECT CASE(equationsmatrix%STORAGE_TYPE)
4813  CASE(matrix_compressed_row_storage_type)
4814  linearmatrices=>equationsmatrix%LINEAR_MATRICES
4815  dynamicmatrices=>equationsmatrix%DYNAMIC_MATRICES
4816  IF(ASSOCIATED(dynamicmatrices).OR.ASSOCIATED(linearmatrices)) THEN
4817  IF(ASSOCIATED(dynamicmatrices)) THEN
4818  equationsmatrices=>dynamicmatrices%EQUATIONS_MATRICES
4819  ELSE
4820  equationsmatrices=>linearmatrices%EQUATIONS_MATRICES
4821  ENDIF
4822  IF(ASSOCIATED(equationsmatrices)) THEN
4823  equations=>equationsmatrices%EQUATIONS
4824  IF(ASSOCIATED(equations)) THEN
4825  equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
4826  IF(ASSOCIATED(equationsmapping)) THEN
4827  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
4828  linearmapping=>equationsmapping%LINEAR_MAPPING
4829  IF(ASSOCIATED(dynamicmapping).OR.ASSOCIATED(linearmapping)) THEN
4830  equationsset=>equations%EQUATIONS_SET
4831  IF(ASSOCIATED(equationsset)) THEN
4832  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
4833  IF(ASSOCIATED(dependentfield)) THEN
4834  IF(ASSOCIATED(dynamicmatrices)) THEN
4835  fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4836  ELSE
4837  fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4838  ENDIF
4839  IF(ASSOCIATED(fieldvariable)) THEN
4840  dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
4841  IF(ASSOCIATED(dependentdofsdomainmapping)) THEN
4842  dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
4843  IF(ASSOCIATED(dependentdofsparammapping)) THEN
4844  !Allocate lists
4845  ALLOCATE(columnindiceslists(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
4846  IF(err/=0) CALL flagerror("Could not allocate column indices lists.",err,error,*999)
4847  !Allocate row indices
4848  ALLOCATE(rowindices(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
4849  IF(err/=0) CALL flagerror("Could not allocate row indices.",err,error,*999)
4850  rowindices(1)=1
4851 
4852  !First, loop over the rows and calculate the number of non-zeros
4853  numberofnonzeros=0
4854  DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4855  IF(dependentdofsparammapping%DOF_TYPE(1,localdofidx)==field_node_dof_type) THEN
4856  dofidx=dependentdofsparammapping%DOF_TYPE(2,localdofidx)!value for a particular field dof (localDofIdx)
4857  nodeidx=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,dofidx)!node number (np) of the field parameter
4858  componentidx=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,dofidx)!component number (nh) of the field parameter
4859  domainnodes=>fieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
4860 
4861  !Set up list
4862  NULLIFY(columnindiceslists(localdofidx)%PTR)
4863  CALL list_create_start(columnindiceslists(localdofidx)%PTR,err,error,*999)
4864  CALL list_data_type_set(columnindiceslists(localdofidx)%PTR,list_intg_type,err,error,*999)
4865 
4866  CALL list_initial_size_set(columnindiceslists(localdofidx)%PTR, &
4867  & fieldvariable%NUMBER_OF_COMPONENTS* &
4868  & fieldvariable%maxNumberElementInterpolationParameters,err,error,*999)
4869 
4870  CALL list_create_finish(columnindiceslists(localdofidx)%PTR,err,error,*999)
4871  !Loop over all components,nodes,derivatives, and versions
4872  DO componentidx=1,fieldvariable%NUMBER_OF_COMPONENTS
4873  numberofderivatives=fieldvariable%components(componentidx)%domain%topology% &
4874  & nodes%nodes(nodeidx)%NUMBER_OF_DERIVATIVES
4875  DO derivativeidx=1,numberofderivatives
4876  numberofversions=fieldvariable%components(componentidx)%domain%topology% &
4877  & nodes%nodes(nodeidx)%derivatives(derivativeidx)%numberOfVersions
4878  DO versionidx=1,numberofversions
4879  localcolumn=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
4880  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
4881  globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
4882 
4883  CALL list_item_add(columnindiceslists(localdofidx)%PTR,globalcolumn,err,error,*999)
4884 
4885  ENDDO !versionIdx
4886  ENDDO !derivativeIdx
4887  ENDDO !componentIdx
4888 
4889  CALL list_remove_duplicates(columnindiceslists(localdofidx)%PTR,err,error,*999)
4890  CALL list_number_of_items_get(columnindiceslists(localdofidx)%PTR,numberofcolumns, &
4891  & err,error,*999)
4892  numberofnonzeros=numberofnonzeros+numberofcolumns
4893  rowindices(localdofidx+1)=numberofnonzeros+1
4894  ELSE
4895  localerror="Local dof number "//trim(numbertovstring(localdofidx,"*",err,error))// &
4896  & " is not a node based dof."
4897  CALL flagerror(localerror,err,error,*999)
4898  ENDIF
4899  ENDDO !localDofIdx
4900 
4901  !Allocate and setup the column locations
4902  ALLOCATE(columnindices(numberofnonzeros),stat=err)
4903  ALLOCATE(list(dependentdofsdomainmapping%NUMBER_OF_GLOBAL))
4904 
4905  IF(err/=0) CALL flagerror("Could not allocate column indices.",err,error,*999)
4906  DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4907 
4908  CALL list_detach_and_destroy(columnindiceslists(localdofidx)%PTR,numberofcolumns,columns, &
4909  & err,error,*999)
4910  DO columnidx=1,numberofcolumns
4911  !columns store the list of nonzero column indices for each local row (localDofIdx)
4912  columnindices(rowindices(localdofidx)+columnidx-1)=columns(columnidx)
4913 
4914  ! global to local columns
4915  IF(ASSOCIATED(linearmapping).OR.ASSOCIATED(dynamicmapping)) THEN
4916  IF(ASSOCIATED(dynamicmatrices)) THEN
4917  local_cols=equationsmatrices%equations_mapping%dynamic_mapping &
4918  & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4919  & (columns(columnidx))%LOCAL_NUMBER(1)
4920  local_dof = local_cols
4921  ! Column to dof mapping?
4922  !local_dof=equationsMatrices%equations_mapping%dynamic_mapping% &
4923  ! & equations_matrix_to_var_maps(1)%column_to_dof_map(local_cols)
4924  ELSE
4925  local_cols=equationsmatrices%equations_mapping%linear_mapping &
4926  & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4927  & (columns(columnidx))%LOCAL_NUMBER(1)
4928  local_dof = local_cols
4929  ENDIF
4930  ENDIF
4931  nyyg=dependentdofsparammapping%DOF_TYPE(2,local_dof)
4932  npg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyyg)
4933  nhg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyyg)
4934  domainnodes=>fieldvariable%COMPONENTS(nhg)%DOMAIN%TOPOLOGY%NODES
4935 
4936  ! Check whether boundary node
4937  IF(domainnodes%NODES(npg)%BOUNDARY_NODE)THEN
4938  CALL linkedlist_add(list(columns(columnidx)),localdofidx,err,error,*999)
4939  ENDIF
4940 
4941  ENDDO !columnIdx
4942  DEALLOCATE(columns)
4943  ENDDO !localDofIdx
4944 
4945  IF(diagnostics1) THEN
4946  CALL write_string(diagnostic_output_type,"Equations matrix structure:",err,error,*999)
4947  CALL write_string_value(diagnostic_output_type,"Equations matrix number : ",matrixnumber, &
4948  & err,error,*999)
4949  CALL write_string_value(diagnostic_output_type," Number of rows = ", &
4950  & dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL,err,error,*999)
4951  CALL write_string_value(diagnostic_output_type," Number of columns = ", &
4952  & dependentdofsdomainmapping%NUMBER_OF_GLOBAL,err,error,*999)
4953  CALL write_string_value(diagnostic_output_type," Number of non zeros = ", &
4954  & numberofnonzeros,err,error,*999)
4955  IF(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL* &
4956  & dependentdofsdomainmapping%NUMBER_OF_GLOBAL/=0) THEN
4957  sparsity=(1.0_dp-REAL(numberofnonzeros,dp)/REAL(dependentdofsdomainmapping% &
4958  & TOTAL_NUMBER_OF_LOCAL*dependentDofsDomainMapping%NUMBER_OF_GLOBAL,DP))*100.0_DP
4959  CALL WRITE_STRING_FMT_VALUE(diagnostic_output_type," Sparsity (% of zeros) = ", &
4960  & sparsity,"F6.2",err,error,*999)
4961  ENDIF
4962  CALL write_string_vector(diagnostic_output_type,1,1,dependentdofsdomainmapping% &
4963  & total_number_of_local+1,8,8,rowindices,'(" Row indices :",8(X,I13))', &
4964  & '(18X,8(X,I13))',err,error,*999)
4965  CALL write_string_vector(diagnostic_output_type,1,1,numberofnonzeros,8,8,columnindices, &
4966  & '(" Column indices :",8(X,I13))','(18X,8(X,I13))', err,error,*999)
4967  ENDIF
4968  ELSE
4969  CALL flagerror("Dependent dofs parameter mapping is not associated.",err,error,*999)
4970  ENDIF
4971  ELSE
4972  CALL flagerror("Dependent dofs domain mapping is not associated.",err,error,*999)
4973  ENDIF
4974  ELSE
4975  CALL flagerror("Dependent field variable is not associated.",err,error,*999)
4976  ENDIF
4977  ELSE
4978  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
4979  ENDIF
4980  ELSE
4981  CALL flagerror("Equations set is not associated.",err,error,*999)
4982  ENDIF
4983  ELSE
4984  CALL flagerror("Either equations mapping dynamic mapping or linear mapping is not associated.", &
4985  & err,error,*999)
4986  ENDIF
4987  ELSE
4988  CALL flagerror("Equations mapping is not associated.",err,error,*999)
4989  ENDIF
4990  ELSE
4991  CALL flagerror("Equations is not associated.",err,error,*999)
4992  ENDIF
4993  ELSE
4994  CALL flagerror("Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
4995  ENDIF
4996  ELSE
4997  CALL flagerror("Either equations matrix dynamic or linear matrices is not associated.",err,error,*999)
4998  ENDIF
4999 
5000  CASE DEFAULT
5001  localerror="The matrix storage type of "// &
5002  & trim(numbertovstring(equationsmatrix%STORAGE_TYPE,"*",err,error))//" is invalid."
5003  CALL flagerror(localerror,err,error,*999)
5004  END SELECT
5005 
5006  CASE(equations_matrix_diagonal_structure)
5007  CALL flagerror("There is not structure to calculate for a diagonal matrix.",err,error,*998)
5008  CASE DEFAULT
5009  localerror="The matrix structure type of "// &
5010  & trim(numbertovstring(equationsmatrix%STRUCTURE_TYPE,"*",err,error))//" is invalid."
5011  CALL flagerror(localerror,err,error,*998)
5012  END SELECT
5013  ELSE
5014  CALL flagerror("Column indices is already associated.",err,error,*998)
5015  ENDIF
5016  ELSE
5017  CALL flagerror("Row indieces is already associated.",err,error,*998)
5018  ENDIF
5019  ELSE
5020  CALL flagerror("Equations matrix is not associated.",err,error,*999)
5021  ENDIF
5022 
5023  exits("EquationsMatrix_StructureCalculate")
5024  RETURN
5025 999 IF(ASSOCIATED(rowindices)) DEALLOCATE(rowindices)
5026  IF(ASSOCIATED(columnindices)) DEALLOCATE(columnindices)
5027  IF(ALLOCATED(columns)) DEALLOCATE(columns)
5028  IF(ALLOCATED(columnindiceslists)) THEN
5029  DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
5030  IF(ASSOCIATED(columnindiceslists(localdofidx)%PTR)) &
5031  & CALL list_destroy(columnindiceslists(localdofidx)%PTR,dummyerr,dummyerror,*998)
5032  ENDDO !localDofIdx
5033  DEALLOCATE(columnindiceslists)
5034  ENDIF
5035 998 errorsexits("EquationsMatrix_StructureCalculate",err,error)
5036  RETURN 1
5037  END SUBROUTINE equationsmatrix_structurecalculate
5038 
5039  !
5040  !================================================================================================================================
5041  !
5042 
5044  SUBROUTINE jacobianmatrix_structurecalculate(jacobianMatrix,numberOfNonZeros,rowIndices,columnIndices,err,error,*)
5045 
5046  !Argument variables
5047  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
5048  INTEGER(INTG), INTENT(OUT) :: numberOfNonZeros
5049  INTEGER(INTG), POINTER :: rowIndices(:)
5050  INTEGER(INTG), POINTER :: columnIndices(:)
5051  INTEGER(INTG), INTENT(OUT) :: err
5052  TYPE(varying_string), INTENT(OUT) :: error
5053  !Local Variables
5054  INTEGER(INTG) :: columnIdx,dummyErr,elementIdx,globalColumn,localColumn,local_ny,mk,mp,ne,nh,nh2,nn,nnk,np,mv, &
5055  & numberOfColumns,nyy,matrixNumber
5056  INTEGER(INTG) :: dofIdx,nodeIdx,componentIdx,versionIdx,derivativeIdx,numberOfVersions,numberOfDerivatives
5057  INTEGER(INTG) :: localDofIdx
5058  INTEGER(INTG), ALLOCATABLE :: columns(:)
5059  REAL(DP) :: sparsity
5060  TYPE(basis_type), POINTER :: basis
5061  TYPE(domain_mapping_type), POINTER :: dependentDofsDomainMapping,rowDofsDomainMapping
5062  TYPE(domain_elements_type), POINTER :: domainElements
5063  TYPE(domain_nodes_type), POINTER :: domainNodes
5064  TYPE(equations_type), POINTER :: equations
5065  TYPE(equations_mapping_type), POINTER :: equationsMapping
5066  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
5067  TYPE(equations_matrices_type), POINTER :: equationsMatrices
5068  TYPE(equations_matrices_nonlinear_type), POINTER :: NONlinearMatrices
5069  TYPE(equations_set_type), POINTER :: equationsSet
5070  TYPE(field_type), POINTER :: dependentField
5071  TYPE(field_dof_to_param_map_type), POINTER :: dependentDofsParamMapping,rowDofsParamMapping
5072  TYPE(field_variable_type), POINTER :: fieldVariable,rowVariable
5073  TYPE(list_ptr_type), ALLOCATABLE :: columnIndicesLists(:)
5074  TYPE(varying_string) :: dummyError,localError
5075 
5076  enters("JacobianMatrix_StructureCalculate",err,error,*998)
5077 
5078  numberofnonzeros=0
5079  IF(ASSOCIATED(jacobianmatrix)) THEN
5080  matrixnumber=jacobianmatrix%JACOBIAN_NUMBER
5081  IF(.NOT.ASSOCIATED(rowindices)) THEN
5082  IF(.NOT.ASSOCIATED(columnindices)) THEN
5083  SELECT CASE(jacobianmatrix%STRUCTURE_TYPE)
5084  CASE(equations_matrix_no_structure)
5085  CALL flagerror("Not implemented.",err,error,*998)
5086  CASE(equations_matrix_fem_structure)
5087  SELECT CASE(jacobianmatrix%STORAGE_TYPE)
5088  CASE(matrix_compressed_row_storage_type)
5089  nonlinearmatrices=>jacobianmatrix%NONLINEAR_MATRICES
5090  IF(ASSOCIATED(nonlinearmatrices)) THEN
5091  equationsmatrices=>nonlinearmatrices%EQUATIONS_MATRICES
5092  IF(ASSOCIATED(equationsmatrices)) THEN
5093  equations=>equationsmatrices%EQUATIONS
5094  IF(ASSOCIATED(equations)) THEN
5095  equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
5096  IF(ASSOCIATED(equationsmapping)) THEN
5097  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
5098  IF(ASSOCIATED(nonlinearmapping)) THEN
5099  equationsset=>equations%EQUATIONS_SET
5100  IF(ASSOCIATED(equationsset)) THEN
5101  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
5102  IF(ASSOCIATED(dependentfield)) THEN
5103  fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixnumber)%VARIABLE
5104  IF(ASSOCIATED(fieldvariable)) THEN
5105  dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
5106  IF(ASSOCIATED(dependentdofsdomainmapping)) THEN
5107  dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
5108  IF(ASSOCIATED(dependentdofsparammapping)) THEN
5109  !If RHS variable exists, use this for row DOFs, else use the first nonlinear variable
5110  IF(ASSOCIATED(equationsmapping%RHS_MAPPING)) THEN
5111  rowvariable=>equationsmapping%RHS_MAPPING%RHS_VARIABLE
5112  ELSE
5113  rowvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
5114  ENDIF
5115  IF(ASSOCIATED(rowvariable)) THEN
5116  rowdofsdomainmapping=>rowvariable%DOMAIN_MAPPING
5117  rowdofsparammapping=>rowvariable%DOF_TO_PARAM_MAP
5118  ELSE
5119  CALL flagerror("RHS or first nonlinear variable is not associated",err,error,*999)
5120  ENDIF
5121  IF(ASSOCIATED(rowdofsdomainmapping)) THEN
5122  IF(ASSOCIATED(rowdofsparammapping)) THEN
5123  !Allocate lists
5124  ALLOCATE(columnindiceslists(rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
5125  IF(err/=0) CALL flagerror("Could not allocate column indices lists.",err,error,*999)
5126  !Allocate row indices
5127  ALLOCATE(rowindices(rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
5128  IF(err/=0) CALL flagerror("Could not allocate row indices.",err,error,*999)
5129  rowindices(1)=1
5130  !First, loop over the rows and calculate the number of non-zeros
5131  numberofnonzeros=0
5132  DO local_ny=1,rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
5133  SELECT CASE(rowdofsparammapping%DOF_TYPE(1,local_ny))
5134  CASE(field_constant_interpolation)
5135  CALL flagerror("Constant interpolation is not implemented yet.",err,error,*999)
5136  CASE(field_node_dof_type)
5137  nyy=rowdofsparammapping%DOF_TYPE(2,local_ny)
5138  np=rowdofsparammapping%NODE_DOF2PARAM_MAP(3,nyy) !node number
5139  nh=rowdofsparammapping%NODE_DOF2PARAM_MAP(4,nyy) !component number
5140  domainnodes=>rowvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%NODES
5141  !Set up list
5142  NULLIFY(columnindiceslists(local_ny)%PTR)
5143  CALL list_create_start(columnindiceslists(local_ny)%PTR,err,error,*999)
5144  CALL list_data_type_set(columnindiceslists(local_ny)%PTR,list_intg_type,err,error,*999)
5145  CALL list_initial_size_set(columnindiceslists(local_ny)%PTR,domainnodes%NODES(np)% &
5146  & number_of_surrounding_elements*rowvariable%COMPONENTS(nh)% &
5147  & maxnumberelementinterpolationparameters,err,error,*999)
5148  CALL list_create_finish(columnindiceslists(local_ny)%PTR,err,error,*999)
5149  !Loop over all elements containing the dof
5150  DO elementidx=1,domainnodes%NODES(np)%NUMBER_OF_SURROUNDING_ELEMENTS
5151  ne=domainnodes%NODES(np)%SURROUNDING_ELEMENTS(elementidx)
5152  DO nh2=1,fieldvariable%NUMBER_OF_COMPONENTS
5153  SELECT CASE(fieldvariable%COMPONENTS(nh2)%INTERPOLATION_TYPE)
5154  CASE(field_constant_interpolation)
5155  ! do nothing? this will probably never be encountered...?
5156  CASE(field_element_based_interpolation)
5157  localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP% &
5158  & element_param2dof_map%ELEMENTS(ne)
5159  globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
5160  CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn,err,error,*999)
5161  CASE(field_node_based_interpolation)
5162  domainelements=>fieldvariable%COMPONENTS(nh2)%DOMAIN%TOPOLOGY%ELEMENTS
5163  basis=>domainelements%ELEMENTS(ne)%BASIS
5164  DO nn=1,basis%NUMBER_OF_NODES
5165  mp=domainelements%ELEMENTS(ne)%ELEMENT_NODES(nn)
5166  DO nnk=1,basis%NUMBER_OF_DERIVATIVES(nn)
5167  mk=domainelements%ELEMENTS(ne)%ELEMENT_DERIVATIVES(nnk,nn)
5168  mv=domainelements%ELEMENTS(ne)%elementVersions(nnk,nn)
5169  !Find the local and global column and add the global column to the indices list
5170  localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP% &
5171  & node_param2dof_map%NODES(mp)%DERIVATIVES(mk)%VERSIONS(mv)
5172  globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
5173  CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn, &
5174  & err,error,*999)
5175  ENDDO !mk
5176  ENDDO !nn
5177  CASE(field_grid_point_based_interpolation)
5178  CALL flagerror("Grid point based interpolation is not implemented yet.",&
5179  & err,error,*999)
5180  CASE(field_gauss_point_based_interpolation)
5181  CALL flagerror("Gauss point based interpolation is not implemented yet.",&
5182  & err,error,*999)
5183  CASE DEFAULT
5184  localerror="Local dof number "//trim(numbertovstring(local_ny,"*",err,error))// &
5185  & " has invalid interpolation type."
5186  CALL flagerror(localerror,err,error,*999)
5187  END SELECT
5188  ENDDO !nh2
5189  ENDDO !elementIdx
5190  CALL list_remove_duplicates(columnindiceslists(local_ny)%PTR,err,error,*999)
5191  CALL list_number_of_items_get(columnindiceslists(local_ny)%PTR,numberofcolumns, &
5192  & err,error,*999)
5193  numberofnonzeros=numberofnonzeros+numberofcolumns
5194  rowindices(local_ny+1)=numberofnonzeros+1
5195  CASE(field_element_dof_type)
5196  ! row corresponds to a variable that's element-wisely interpolated
5197  nyy=rowdofsparammapping%DOF_TYPE(2,local_ny) ! nyy = index in ELEMENT_DOF2PARAM_MAP
5198  ne=rowdofsparammapping%ELEMENT_DOF2PARAM_MAP(1,nyy) ! current element (i.e. corresponds to current dof)
5199  nh=rowdofsparammapping%ELEMENT_DOF2PARAM_MAP(2,nyy) ! current variable component
5200  domainelements=>rowvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%ELEMENTS
5201  basis=>domainelements%ELEMENTS(ne)%BASIS
5202