OpenCMISS-Iron Internal API Documentation
interface_matrices_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE interface_matrices_routines
46 
47  USE base_routines
48  USE distributed_matrix_vector
49  USE equations_matrices_routines
50  USE field_routines
51  USE input_output
52  USE interface_conditions_constants
53  USE interface_matrices_constants
54  USE iso_varying_string
55  USE kinds
56  USE matrix_vector
57  USE strings
58  USE types
59 
60 #include "macros.h"
61 
62  IMPLICIT NONE
63 
64  PRIVATE
65 
66  !Module parameters
67 
72  INTEGER(INTG), PARAMETER :: interface_matrix_no_structure=1
73  INTEGER(INTG), PARAMETER :: interface_matrix_fem_structure=2
75 
80  INTEGER(INTG), PARAMETER :: interface_matrices_sparse_matrices=1
81  INTEGER(INTG), PARAMETER :: interface_matrices_full_matrices=2
83 
84  !Module types
85 
86  !Module variables
87 
88  !Interfaces
89 
90  PUBLIC interface_matrix_no_structure,interface_matrix_fem_structure
91 
92  PUBLIC interface_matrices_sparse_matrices,interface_matrices_full_matrices
93 
94  PUBLIC interface_matrices_create_finish,interface_matrices_create_start
95 
96  PUBLIC interface_matrices_destroy
97 
98  PUBLIC interface_matrices_element_add
99 
100  PUBLIC interfacematrices_elementcalculate
101 
102  PUBLIC interface_matrices_element_finalise,interfacematrices_elementinitialise
103 
104  PUBLIC interface_matrices_output
105 
106  PUBLIC interface_matrices_storage_type_set
107 
108  PUBLIC interface_matrices_structure_type_set
109 
110  PUBLIC interface_matrices_values_initialise
111 
112  PUBLIC interfacematrix_timedependencetypeset,interfacematrix_timedependencetypeget
113 
114 CONTAINS
115 
116  !
117  !================================================================================================================================
118  !
119 
121  SUBROUTINE interface_matrix_finalise(INTERFACE_MATRIX,ERR,ERROR,*)
122 
123  !Argument variables
124  TYPE(interface_matrix_type), POINTER :: interface_matrix
125  INTEGER(INTG), INTENT(OUT) :: err
126  TYPE(varying_string), INTENT(OUT) :: error
127  !Local Variables
128 
129  enters("INTERFACE_MATRIX_FINALISE",err,error,*999)
130 
131  IF(ASSOCIATED(interface_matrix)) THEN
132  IF(ASSOCIATED(interface_matrix%MATRIX)) CALL distributed_matrix_destroy(interface_matrix%MATRIX,err,error,*999)
133  IF(ASSOCIATED(interface_matrix%MATRIX_TRANSPOSE)) CALL distributed_matrix_destroy(interface_matrix%MATRIX_TRANSPOSE, &
134  & err,error,*999)
135  CALL equations_matrices_element_matrix_finalise(interface_matrix%ELEMENT_MATRIX,err,error,*999)
136  DEALLOCATE(interface_matrix)
137  ENDIF
138 
139  exits("INTERFACE_MATRIX_FINALISE")
140  RETURN
141 999 errorsexits("INTERFACE_MATRIX_FINALISE",err,error)
142  RETURN 1
143  END SUBROUTINE interface_matrix_finalise
144 
145  !
146  !================================================================================================================================
147  !
148 
150  SUBROUTINE interface_matrix_initialise(INTERFACE_MATRICES,MATRIX_NUMBER,ERR,ERROR,*)
151 
152  !Argument variables
153  TYPE(interface_matrices_type), POINTER :: interface_matrices
154  INTEGER(INTG) :: matrix_number
155  INTEGER(INTG), INTENT(OUT) :: err
156  TYPE(varying_string), INTENT(OUT) :: error
157  !Local Variables
158  INTEGER(INTG) :: dummy_err
159  TYPE(interface_mapping_type), POINTER :: interface_mapping
160  TYPE(interface_matrix_type), POINTER :: interface_matrix
161  TYPE(varying_string) :: dummy_error,local_error
162 
163  enters("INTERFACE_MATRIX_INITIALISE",err,error,*998)
164 
165  IF(ASSOCIATED(interface_matrices)) THEN
166  IF(matrix_number>0.AND.matrix_number<=interface_matrices%NUMBER_OF_INTERFACE_MATRICES) THEN
167  interface_mapping=>interface_matrices%INTERFACE_MAPPING
168  IF(ASSOCIATED(interface_mapping)) THEN
169  IF(ASSOCIATED(interface_matrices%MATRICES(matrix_number)%PTR)) THEN
170  local_error="Interface matrix for matrix number "//trim(number_to_vstring(matrix_number,"*",err,error))// &
171  & " is already associated."
172  CALL flagerror(local_error,err,error,*998)
173  ELSE
174  ALLOCATE(interface_matrices%MATRICES(matrix_number)%PTR,stat=err)
175  IF(err/=0) CALL flagerror("Could not allocate interface matrix.",err,error,*999)
176  interface_matrix=>interface_matrices%MATRICES(matrix_number)%PTR
177  interface_matrix%MATRIX_NUMBER=matrix_number
178  interface_matrix%INTERFACE_MATRICES=>interface_matrices
179  interface_matrix%STORAGE_TYPE=matrix_block_storage_type
180  interface_matrix%STRUCTURE_TYPE=interface_matrix_no_structure
181  interface_matrix%UPDATE_MATRIX=.true.
182  interface_matrix%FIRST_ASSEMBLY=.true.
183  interface_matrix%HAS_TRANSPOSE=interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)%HAS_TRANSPOSE
184  interface_matrix%NUMBER_OF_ROWS=interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)%NUMBER_OF_ROWS
185  interface_matrix%TOTAL_NUMBER_OF_ROWS=interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)% &
186  & total_number_of_rows
187  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)%INTERFACE_MATRIX=>interface_matrix
188  NULLIFY(interface_matrix%MATRIX)
189  NULLIFY(interface_matrix%MATRIX_TRANSPOSE)
190  NULLIFY(interface_matrix%TEMP_VECTOR)
191  NULLIFY(interface_matrix%TEMP_TRANSPOSE_VECTOR)
192  CALL equationsmatrices_elementmatrixinitialise(interface_matrix%ELEMENT_MATRIX,err,error,*999)
193  ENDIF
194  ELSE
195  CALL flagerror("Interface mapping is not associated.",err,error,*998)
196  ENDIF
197  ELSE
198  local_error="The specified interface matrix number of "//trim(number_to_vstring(matrix_number,"*",err,error))// &
199  & " is invalid. The matrix number must be > 0 and <= "// &
200  & trim(number_to_vstring(interface_matrices%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//"."
201  CALL flagerror(local_error,err,error,*998)
202  ENDIF
203  ELSE
204  CALL flagerror("Interface matrices is not associated.",err,error,*998)
205  ENDIF
206 
207  exits("INTERFACE_MATRIX_INITIALISE")
208  RETURN
209 999 CALL interface_matrix_finalise(interface_matrices%MATRICES(matrix_number)%PTR,dummy_err,dummy_error,*998)
210 998 errorsexits("INTERFACE_MATRIX_INITIALISE",err,error)
211  RETURN 1
212 
213  END SUBROUTINE interface_matrix_initialise
214 
215  !
216  !================================================================================================================================
217  !
218 
220  SUBROUTINE interface_matrices_element_add(INTERFACE_MATRICES,ERR,ERROR,*)
221 
222  !Argument variables
223  TYPE(interface_matrices_type), POINTER :: interface_matrices
224  INTEGER(INTG), INTENT(OUT) :: err
225  TYPE(varying_string), INTENT(OUT) :: error
226  !Local Variables
227  INTEGER(INTG) :: matrix_idx
228  TYPE(interface_matrix_type), POINTER :: interface_matrix
229  TYPE(interface_rhs_type), POINTER :: rhs_vector
230  TYPE(varying_string) :: local_error
231 
232 #ifdef TAUPROF
233  CALL tau_static_phase_start("INTERFACE_MATRICES_ELEMENT_ADD()")
234 #endif
235 
236  enters("INTERFACE_MATRICES_ELEMENT_ADD",err,error,*999)
237 
238  IF(ASSOCIATED(interface_matrices)) THEN
239  !Add the element matrices
240  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
241  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
242  IF(ASSOCIATED(interface_matrix)) THEN
243  IF(interface_matrix%UPDATE_MATRIX) THEN
244  !Add the element matrix into the distributed interface equations matrix
245  CALL distributed_matrix_values_add(interface_matrix%MATRIX,interface_matrix%ELEMENT_MATRIX%ROW_DOFS(1: &
246  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),interface_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
247  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),interface_matrix%ELEMENT_MATRIX%MATRIX(1: &
248  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:interface_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS), &
249  & err,error,*999)
250  !If the interface matrix has a transpose add it
251  IF(interface_matrix%HAS_TRANSPOSE) THEN
252  CALL distributed_matrix_values_add(interface_matrix%MATRIX_TRANSPOSE,interface_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
253  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),interface_matrix%ELEMENT_MATRIX%ROW_DOFS(1: &
254  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),transpose(interface_matrix%ELEMENT_MATRIX%MATRIX(1: &
255  & interface_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:interface_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS)), &
256  & err,error,*999)
257  ENDIF
258  ENDIF
259  ELSE
260  local_error="Interface matrix for interface matrix number "//trim(number_to_vstring(matrix_idx,"*",err,error))// &
261  & " is not associated."
262  CALL flagerror(local_error,err,error,*999)
263  ENDIF
264  ENDDO !matrix_idx
265  rhs_vector=>interface_matrices%RHS_VECTOR
266  IF(ASSOCIATED(rhs_vector)) THEN
267  IF(rhs_vector%UPDATE_VECTOR) THEN
268  !Add the rhs element vector
269  CALL distributed_vector_values_add(rhs_vector%RHS_VECTOR,rhs_vector%ELEMENT_VECTOR%ROW_DOFS(1: &
270  & rhs_vector%ELEMENT_VECTOR%NUMBER_OF_ROWS),rhs_vector%ELEMENT_VECTOR%VECTOR(1:rhs_vector% &
271  & element_vector%NUMBER_OF_ROWS),err,error,*999)
272  ENDIF
273  ENDIF
274  ELSE
275  CALL flagerror("Interface matrices is not allocated.",err,error,*999)
276  ENDIF
277 #ifdef TAUPROF
278  CALL tau_static_phase_stop("INTERFACE_MATRICES_ELEMENT_ADD()")
279 #endif
280 
281  exits("INTERFACE_MATRICES_ELEMENT_ADD")
282  RETURN
283 999 errorsexits("INTERFACE_MATRICES_ELEMENT_ADD",err,error)
284  RETURN 1
285  END SUBROUTINE interface_matrices_element_add
286 
287  !
288  !================================================================================================================================
289  !
290 
292  SUBROUTINE interfacematrices_elementcalculate(interfaceMatrices,interfaceElementNumber,err,error,*)
293 
294  !Argument variables
295  TYPE(interface_matrices_type), POINTER :: interfacematrices
296  INTEGER(INTG), INTENT(IN) :: interfaceelementnumber
297  INTEGER(INTG), INTENT(OUT) :: err
298  TYPE(varying_string), INTENT(OUT) :: error
299  !Local Variables
300  INTEGER(INTG) :: matrixidx,rowselementnumber,rowsmeshidx
301  TYPE(field_variable_type), POINTER :: colsfieldvariable,rowsfieldvariable
302  TYPE(interface_type), POINTER :: interface
303  TYPE(interface_condition_type), POINTER :: interfacecondition
304  TYPE(interface_equations_type), POINTER :: interfaceequations
305  TYPE(interface_mapping_type), POINTER :: interfacemapping
306  TYPE(interface_mapping_rhs_type), POINTER :: rhsmapping
307  TYPE(interface_matrix_type), POINTER :: interfacematrix
308  TYPE(interface_rhs_type), POINTER :: rhsvector
309  TYPE(interface_mesh_connectivity_type), POINTER :: meshconnectivity
310  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
311  TYPE(varying_string) :: localerror
312 
313 #ifdef TAUPROF
314  CALL tau_static_phase_start("InterfaceMatrices_ElementCalculate()")
315 #endif
316 
317  enters("InterfaceMatrices_ElementCalculate",err,error,*999)
318 
319  IF(ASSOCIATED(interfacematrices)) THEN
320  interfacemapping=>interfacematrices%INTERFACE_MAPPING
321  IF(ASSOCIATED(interfacemapping)) THEN
322  interfaceequations=>interfacemapping%INTERFACE_EQUATIONS
323  IF(ASSOCIATED(interfaceequations)) THEN
324  interfacecondition=>interfaceequations%INTERFACE_CONDITION
325  IF(ASSOCIATED(interfacecondition)) THEN
326  interface=>interfacecondition%INTERFACE
327  IF(ASSOCIATED(interface)) THEN
328  SELECT CASE(interfacecondition%integrationType)
329  CASE(interface_condition_gauss_integration)
330  meshconnectivity=>interface%MESH_CONNECTIVITY
331  IF(ASSOCIATED(meshconnectivity)) THEN
332  IF(ALLOCATED(meshconnectivity%ELEMENT_CONNECTIVITY)) THEN
333  !Calculate the row and columns for the interface equations matrices
334  DO matrixidx=1,interfacematrices%NUMBER_OF_INTERFACE_MATRICES
335  interfacematrix=>interfacematrices%MATRICES(matrixidx)%PTR
336  IF(ASSOCIATED(interfacematrix)) THEN
337  rowsfieldvariable=>interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%VARIABLE
338  colsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE !\todo: TEMPORARY: Needs generalising
339  rowsmeshidx=interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%MESH_INDEX
340  IF(ASSOCIATED(rowsfieldvariable,colsfieldvariable)) THEN
341  ! If the rows and column variables are both the Lagrange variable (this is the diagonal matrix)
342  rowselementnumber=interfaceelementnumber
343  ELSE
344  rowselementnumber=meshconnectivity%ELEMENT_CONNECTIVITY(interfaceelementnumber,rowsmeshidx)% &
345  & coupled_mesh_element_number
346  ENDIF
347  CALL equations_matrices_element_matrix_calculate(interfacematrix%ELEMENT_MATRIX, &
348  & interfacematrix%UPDATE_MATRIX,[rowselementnumber],[interfaceelementnumber],rowsfieldvariable, &
349  & colsfieldvariable,err,error,*999)
350  ELSE
351  localerror="Interface matrix number "//trim(number_to_vstring(matrixidx,"*",err,error))// &
352  & " is not associated."
353  CALL flagerror(localerror,err,error,*999)
354  ENDIF
355  ENDDO !matrixIdx
356  ELSE
357  CALL flagerror("Interface element connectivity is not associated.",err,error,*999)
358  ENDIF
359  ELSE
360  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
361  ENDIF
362  CASE(interface_condition_data_points_integration)
363  pointsconnectivity=>interface%pointsConnectivity
364  IF(ASSOCIATED(pointsconnectivity)) THEN
365  IF(ALLOCATED(pointsconnectivity%coupledElements)) THEN
366  DO matrixidx=1,interfacematrices%NUMBER_OF_INTERFACE_MATRICES
367  interfacematrix=>interfacematrices%MATRICES(matrixidx)%PTR
368  IF(ASSOCIATED(interfacematrix)) THEN
369  IF(interfacecondition%METHOD==interface_condition_penalty_method .AND. &
370  matrixidx==interfacematrices%NUMBER_OF_INTERFACE_MATRICES) THEN
371  rowsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE
372  colsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE
373  CALL equations_matrices_element_matrix_calculate(interfacematrix%ELEMENT_MATRIX, &
374  & interfacematrix%UPDATE_MATRIX,[interfaceelementnumber],[interfaceelementnumber], &
375  & rowsfieldvariable,colsfieldvariable,err,error,*999)
376  ELSE
377  rowsfieldvariable=>interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%VARIABLE
378  colsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE !\todo: TEMPORARY: Needs generalising
379  rowsmeshidx=interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%MESH_INDEX
380  CALL equations_matrices_element_matrix_calculate(interfacematrix%ELEMENT_MATRIX, &
381  & interfacematrix%UPDATE_MATRIX,pointsconnectivity%coupledElements(interfaceelementnumber, &
382  & rowsmeshidx)%elementNumbers,[interfaceelementnumber],rowsfieldvariable,colsfieldvariable, &
383  & err,error,*999)
384  ENDIF
385  ELSE
386  localerror="Interface matrix number "//trim(number_to_vstring(matrixidx,"*",err,error))// &
387  & " is not associated."
388  CALL flagerror(localerror,err,error,*999)
389  ENDIF
390  ENDDO !matrixIdx
391  ELSE
392  CALL flagerror("Interface points connectivity coupled elements is not allocated.",err,error,*999)
393  ENDIF
394  ELSE
395  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
396  ENDIF
397  CASE DEFAULT
398  localerror="The interface condition integration type of "// &
399  & trim(number_to_vstring(interfacecondition%integrationType,"*",err,error))//" is invalid."
400  CALL flagerror(localerror,err,error,*999)
401  END SELECT
402  !RHS element matrix dofs are the same for both mesh and points connectivity, right now
403  rhsvector=>interfacematrices%RHS_VECTOR
404  IF(ASSOCIATED(rhsvector)) THEN
405  rhsmapping=>interfacemapping%RHS_MAPPING
406  IF(ASSOCIATED(rhsmapping)) THEN
407  !Calculate the rows for the equations RHS
408  rowsfieldvariable=>rhsmapping%RHS_VARIABLE
409  CALL equations_matrices_element_vector_calculate(rhsvector%ELEMENT_VECTOR,rhsvector%UPDATE_VECTOR, &
410  & interfaceelementnumber,rowsfieldvariable,err,error,*999)
411  ELSE
412  CALL flagerror("Interface mapping rhs mapping is not associated.",err,error,*999)
413  ENDIF
414  ENDIF
415  ELSE
416  CALL flagerror("Interface condition interface is not associated.",err,error,*999)
417  ENDIF
418  ELSE
419  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
420  ENDIF
421  ELSE
422  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
423  ENDIF
424  ELSE
425  CALL flagerror("Interface mapping is not associated.",err,error,*999)
426  ENDIF
427  ELSE
428  CALL flagerror("Interface matrices is not allocated",err,error,*999)
429  ENDIF
430 
431 #ifdef TAUPROF
432  CALL tau_static_phase_stop("InterfaceMatrices_ElementCalculate()")
433 #endif
434 
435  exits("InterfaceMatrices_ElementCalculate")
436  RETURN
437 999 errorsexits("InterfaceMatrices_ElementCalculate",err,error)
438  RETURN 1
439  END SUBROUTINE interfacematrices_elementcalculate
440 
441  !
442  !================================================================================================================================
443  !
444 
446  SUBROUTINE interface_matrices_element_finalise(INTERFACE_MATRICES,ERR,ERROR,*)
447 
448  !Argument variables
449  TYPE(interface_matrices_type), POINTER :: interface_matrices
450  INTEGER(INTG), INTENT(OUT) :: err
451  TYPE(varying_string), INTENT(OUT) :: error
452  !Local Variables
453  INTEGER(INTG) :: matrix_idx
454  TYPE(interface_matrix_type), POINTER :: interface_matrix
455  TYPE(interface_rhs_type), POINTER :: rhs_vector
456  TYPE(varying_string) :: local_error
457 
458  enters("INTERFACE_MATRICES_ELEMENT_FINALISE",err,error,*999)
459 
460  IF(ASSOCIATED(interface_matrices)) THEN
461  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
462  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
463  IF(ASSOCIATED(interface_matrix)) THEN
464  CALL equations_matrices_element_matrix_finalise(interface_matrix%ELEMENT_MATRIX,err,error,*999)
465  ELSE
466  local_error="Interface matrix number "//trim(number_to_vstring(matrix_idx,"*",err,error))// &
467  & " is not associated."
468  CALL flagerror(local_error,err,error,*999)
469  ENDIF
470  rhs_vector=>interface_matrices%RHS_VECTOR
471  IF(ASSOCIATED(rhs_vector)) THEN
472  !Finalise the interface element vector
473  rhs_vector%ELEMENT_VECTOR%MAX_NUMBER_OF_ROWS=0
474  IF(ALLOCATED(rhs_vector%ELEMENT_VECTOR%ROW_DOFS)) DEALLOCATE(rhs_vector%ELEMENT_VECTOR%ROW_DOFS)
475  IF(ALLOCATED(rhs_vector%ELEMENT_VECTOR%VECTOR)) DEALLOCATE(rhs_vector%ELEMENT_VECTOR%VECTOR)
476  ENDIF
477 
478  ENDDO !matrix_idx
479  ELSE
480  CALL flagerror("Interface matrices is not associated.",err,error,*999)
481  ENDIF
482 
483  exits("INTERFACE_MATRICES_ELEMENT_FINALISE")
484  RETURN
485 999 errorsexits("INTERFACE_MATRICES_ELEMENT_FINALISE",err,error)
486  RETURN 1
487  END SUBROUTINE interface_matrices_element_finalise
488 
489  !
490  !================================================================================================================================
491  !
492 
494  SUBROUTINE interfacematrices_elementinitialise(interfaceMatrices,err,error,*)
495 
496  !Argument variables
497  TYPE(interface_matrices_type), POINTER :: interfacematrices !The interface matrices to initialise the element information for
498  INTEGER(INTG), INTENT(OUT) :: err
499  TYPE(varying_string), INTENT(OUT) :: error
500  !Local Variables
501  INTEGER(INTG) :: matrixidx,rowsmeshidx
502  INTEGER(INTG) :: rowsnumberofelements,colsnumberofelements !Number of elements in the row and col variables whose dofs are present in interface element matrix
503  TYPE(interface_mapping_type), POINTER :: interfacemapping
504  TYPE(interface_condition_type), POINTER :: interfacecondition
505  TYPE(interface_equations_type), POINTER :: interfaceequations
506  TYPE(interface_type), POINTER :: interface
507  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
508  TYPE(interface_matrix_type), POINTER :: interfacematrix
509  TYPE(interface_rhs_type), POINTER :: rhsvector
510  TYPE(interface_mapping_rhs_type), POINTER :: rhsmapping
511  TYPE(field_variable_type), POINTER :: colsfieldvariable,rowsfieldvariable
512  TYPE(varying_string) :: localerror
513 
514  enters("InterfaceMatrices_ElementInitialise",err,error,*999)
515 
516  IF(ASSOCIATED(interfacematrices)) THEN
517  interfacemapping=>interfacematrices%INTERFACE_MAPPING
518  IF(ASSOCIATED(interfacemapping)) THEN
519  interfaceequations=>interfacemapping%INTERFACE_EQUATIONS
520  IF(ASSOCIATED(interfaceequations)) THEN
521  interfacecondition=>interfaceequations%INTERFACE_CONDITION
522  IF(ASSOCIATED(interfacecondition)) THEN
523  SELECT CASE(interfacecondition%integrationType)
524  CASE(interface_condition_gauss_integration)
525  DO matrixidx=1,interfacematrices%NUMBER_OF_INTERFACE_MATRICES
526  interfacematrix=>interfacematrices%MATRICES(matrixidx)%PTR
527  IF(ASSOCIATED(interfacematrix)) THEN
528  rowsnumberofelements=1
529  colsnumberofelements=1
530  rowsfieldvariable=>interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%VARIABLE
531  colsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE !TEMPORARY: Needs generalising
532  CALL equations_matrices_element_matrix_setup(interfacematrix%ELEMENT_MATRIX,rowsfieldvariable, &
533  & colsfieldvariable,rowsnumberofelements,colsnumberofelements,err,error,*999)
534  ELSE
535  localerror="Interface matrix number "//trim(number_to_vstring(matrixidx,"*",err,error))// &
536  & " is not associated."
537  CALL flagerror(localerror,err,error,*999)
538  ENDIF
539  ENDDO !matrixIdx
540  CASE(interface_condition_data_points_integration)
541  interface=>interfacecondition%INTERFACE
542  IF(ASSOCIATED(interface))THEN
543  pointsconnectivity=>interface%pointsConnectivity
544  IF(ASSOCIATED(pointsconnectivity)) THEN
545  IF(ALLOCATED(pointsconnectivity%coupledElements)) THEN
546  DO matrixidx=1,interfacematrices%NUMBER_OF_INTERFACE_MATRICES !\todo: Need to separate the case for penalty matrix
547  interfacematrix=>interfacematrices%MATRICES(matrixidx)%PTR
548  IF(ASSOCIATED(interfacematrix)) THEN
549  colsnumberofelements=1
550  rowsfieldvariable=>interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%VARIABLE
551  colsfieldvariable=>interfacemapping%LAGRANGE_VARIABLE !TEMPORARY: Needs generalising
552  rowsmeshidx=interfacemapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrixidx)%MESH_INDEX
553  CALL equations_matrices_element_matrix_setup(interfacematrix%ELEMENT_MATRIX,rowsfieldvariable, &
554  & colsfieldvariable,pointsconnectivity%maxNumberOfCoupledElements(rowsmeshidx), &
555  & colsnumberofelements,err,error,*999)
556  ELSE
557  localerror="Interface matrix number "//trim(number_to_vstring(matrixidx,"*",err,error))// &
558  & " is not associated."
559  CALL flagerror(localerror,err,error,*999)
560  ENDIF
561  ENDDO !matrixIdx
562  ELSE
563  CALL flagerror("Interface points connectivity coupled elements is not allocated.",err,error,*999)
564  ENDIF
565  ELSE
566  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
567  ENDIF
568  ELSE
569  CALL flagerror("Interface is not associated.",err,error,*999)
570  ENDIF
571  CASE DEFAULT
572  localerror="The interface condition integration type of "// &
573  & trim(number_to_vstring(interfacecondition%integrationType,"*",err,error))//" is invalid."
574  CALL flagerror(localerror,err,error,*999)
575  END SELECT
576  ELSE
577  CALL flagerror("Interface condition is not associated.",err,error,*999)
578  ENDIF
579  ELSE
580  CALL flagerror("Interface equations is not associated.",err,error,*999)
581  ENDIF
582  rhsvector=>interfacematrices%RHS_VECTOR
583  IF(ASSOCIATED(rhsvector)) THEN
584  !Initialise the RHS element vector
585  rhsmapping=>interfacemapping%RHS_MAPPING
586  IF(ASSOCIATED(rhsmapping)) THEN
587  rowsfieldvariable=>rhsmapping%RHS_VARIABLE
588  CALL equations_matrices_element_vector_setup(rhsvector%ELEMENT_VECTOR,rowsfieldvariable,err,error,*999)
589  ELSE
590  CALL flagerror("RHS mapping is not associated.",err,error,*999)
591  ENDIF
592  ENDIF
593  ELSE
594  CALL flagerror("Interface matrices mapping is not associated.",err,error,*999)
595  ENDIF
596  ELSE
597  CALL flagerror("Interface matrices is not associated.",err,error,*999)
598  ENDIF
599 
600  exits("InterfaceMatrices_ElementInitialise")
601  RETURN
602 999 errorsexits("InterfaceMatrices_ElementInitialise",err,error)
603  RETURN 1
604  END SUBROUTINE interfacematrices_elementinitialise
605 
606  !
607  !================================================================================================================================
608  !
609 
611  SUBROUTINE interface_matrix_structure_calculate(INTERFACE_MATRIX,NUMBER_OF_NON_ZEROS,ROW_INDICES,COLUMN_INDICES, &
612  & transpose_row_indices,transpose_column_indices,err,error,*)
613 
614  !Argument variables
615  TYPE(interface_matrix_type), POINTER :: interface_matrix
616  INTEGER(INTG), INTENT(OUT) :: number_of_non_zeros
617  INTEGER(INTG), POINTER :: row_indices(:)
618  INTEGER(INTG), POINTER :: column_indices(:)
619  INTEGER(INTG), POINTER :: transpose_row_indices(:)
620  INTEGER(INTG), POINTER :: transpose_column_indices(:)
621  INTEGER(INTG), INTENT(OUT) :: err
622  TYPE(varying_string), INTENT(OUT) :: error
623  !Local Variables
624  INTEGER(INTG) :: column_version,column_derivative,column_idx,column_component_idx,column_local_derivative_idx, &
625  & column_local_node_idx, column_node,DUMMY_ERR,domain_element,global_column,global_row,interface_element_idx, &
626  & INTERFACE_MESH_INDEX,local_column,local_row,MATRIX_NUMBER,NUMBER_OF_COLUMNS,NUMBER_OF_ROWS,row_component_idx, &
627  & row_version,row_derivative,row_local_derivative_idx,row_idx,row_local_node_idx,row_node,TRANSPOSE_NUMBER_OF_NON_ZEROS
628  INTEGER(INTG), ALLOCATABLE :: columns(:),transpose_columns(:)
629  REAL(DP) :: sparsity
630  TYPE(basis_type), POINTER :: column_basis,row_basis
631  TYPE(domain_mapping_type), POINTER :: column_dofs_domain_mapping,row_dofs_domain_mapping
632  TYPE(domain_elements_type), POINTER :: column_domain_elements,row_domain_elements
633  TYPE(interface_type), POINTER :: interface
634  TYPE(interface_condition_type), POINTER :: interface_condition
635  TYPE(interface_equations_type), POINTER :: interface_equations
636  TYPE(interface_mapping_type), POINTER :: interface_mapping
637  TYPE(interface_matrices_type), POINTER :: interface_matrices
638  TYPE(interface_mesh_connectivity_type), POINTER :: mesh_connectivity
639  TYPE(field_dof_to_param_map_type), POINTER :: column_dofs_param_mapping,row_dofs_param_mapping
640  TYPE(field_variable_type), POINTER :: column_variable,row_variable
641  TYPE(list_ptr_type), ALLOCATABLE :: column_indices_lists(:)
642  TYPE(list_ptr_type), ALLOCATABLE :: transpose_column_indices_lists(:)
643  TYPE(varying_string) :: dummy_error,local_error
644 
645  enters("INTERFACE_MATRIX_STRUCTURE_CALCULATE",err,error,*999)
646 
647  number_of_non_zeros=0
648  IF(ASSOCIATED(interface_matrix)) THEN
649  IF(.NOT.ASSOCIATED(row_indices)) THEN
650  IF(.NOT.ASSOCIATED(column_indices)) THEN
651  IF(.NOT.ASSOCIATED(transpose_row_indices)) THEN
652  IF(.NOT.ASSOCIATED(transpose_column_indices)) THEN
653  matrix_number=interface_matrix%MATRIX_NUMBER
654  SELECT CASE(interface_matrix%STRUCTURE_TYPE)
655  CASE(interface_matrix_no_structure)
656  CALL flagerror("There is no structure to calculate for a matrix with no structure.",err,error,*998)
657  CASE(interface_matrix_fem_structure)
658  SELECT CASE(interface_matrix%STORAGE_TYPE)
659  CASE(matrix_compressed_row_storage_type)
660  interface_matrices=>interface_matrix%INTERFACE_MATRICES
661  IF(ASSOCIATED(interface_matrices)) THEN
662  interface_equations=>interface_matrices%INTERFACE_EQUATIONS
663  IF(ASSOCIATED(interface_equations)) THEN
664  interface_mapping=>interface_matrices%INTERFACE_MAPPING
665  IF(ASSOCIATED(interface_mapping)) THEN
666  interface_condition=>interface_equations%INTERFACE_CONDITION
667  IF(ASSOCIATED(interface_condition)) THEN
668  interface=>interface_condition%INTERFACE
669  IF(ASSOCIATED(interface)) THEN
670  mesh_connectivity=>interface%MESH_CONNECTIVITY
671  IF(ASSOCIATED(mesh_connectivity)) THEN
672  row_variable=>interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)%VARIABLE
673  interface_mesh_index=interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_number)%MESH_INDEX
674  IF(ASSOCIATED(row_variable)) THEN
675  column_variable=>interface_mapping%LAGRANGE_VARIABLE
676  IF(ASSOCIATED(column_variable)) THEN
677  row_dofs_domain_mapping=>row_variable%DOMAIN_MAPPING
678  IF(ASSOCIATED(row_dofs_domain_mapping)) THEN
679  column_dofs_domain_mapping=>column_variable%DOMAIN_MAPPING
680  IF(ASSOCIATED(column_dofs_domain_mapping)) THEN
681  row_dofs_param_mapping=>row_variable%DOF_TO_PARAM_MAP
682  IF(ASSOCIATED(row_dofs_param_mapping)) THEN
683  column_dofs_param_mapping=>column_variable%DOF_TO_PARAM_MAP
684  IF(ASSOCIATED(column_dofs_param_mapping)) THEN
685  !Allocate lists
686  ALLOCATE(column_indices_lists(row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
687  IF(err/=0) CALL flagerror("Could not allocate column indices lists.",err,error,*999)
688  DO local_row=1,row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
689  !Set up list
690  NULLIFY(column_indices_lists(local_row)%PTR)
691  CALL list_create_start(column_indices_lists(local_row)%PTR,err,error,*999)
692  CALL list_data_type_set(column_indices_lists(local_row)%PTR,list_intg_type, &
693  & err,error,*999)
694  CALL list_initial_size_set(column_indices_lists(local_row)%PTR,50,err,error,*999)
695  CALL list_create_finish(column_indices_lists(local_row)%PTR,err,error,*999)
696  ENDDO !local_row
697  !Allocate row indices
698  ALLOCATE(row_indices(row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
699  IF(err/=0) CALL flagerror("Could not allocate row indices.",err,error,*999)
700  IF(interface_matrix%HAS_TRANSPOSE) THEN
701  !Allocate transpose lists
702  ALLOCATE(transpose_column_indices_lists(column_dofs_domain_mapping% &
703  & total_number_of_local),stat=err)
704  IF(err/=0) CALL flagerror("Could not allocate transpose column indices lists.", &
705  & err,error,*999)
706  DO local_column=1,column_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
707  !Set up list
708  NULLIFY(transpose_column_indices_lists(local_column)%PTR)
709  CALL list_create_start(transpose_column_indices_lists(local_column)%PTR, &
710  & err,error,*999)
711  CALL list_data_type_set(transpose_column_indices_lists(local_column)%PTR, &
712  & list_intg_type,err,error,*999)
713  CALL list_initial_size_set(transpose_column_indices_lists(local_column)%PTR,50, &
714  & err,error,*999)
715  CALL list_create_finish(transpose_column_indices_lists(local_column)%PTR, &
716  & err,error,*999)
717  ENDDO !local_column
718  !Allocate transpose row indices
719  ALLOCATE(transpose_row_indices(column_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL+1), &
720  & stat=err)
721  IF(err/=0) CALL flagerror("Could not allocate transpose row indices.",err,error,*999)
722  ENDIF
723  !Loop over the number of components in the Lagrange multipler variable
724  DO column_component_idx=1,column_variable%NUMBER_OF_COMPONENTS
725  IF(column_variable%COMPONENTS(column_component_idx)%INTERPOLATION_TYPE== &
726  & field_node_based_interpolation) THEN
727  !Loop over the elements in the interface mesh
728  column_domain_elements=>column_variable%COMPONENTS(column_component_idx)%DOMAIN% &
729  & topology%ELEMENTS
730  DO interface_element_idx=1,column_domain_elements%TOTAL_NUMBER_OF_ELEMENTS
731  column_basis=>column_domain_elements%ELEMENTS(interface_element_idx)%BASIS
732  !Loop over the column DOFs in the element
733  DO column_local_node_idx=1,column_basis%NUMBER_OF_NODES
734  column_node=column_domain_elements%ELEMENTS(interface_element_idx)% &
735  & element_nodes(column_local_node_idx)
736  DO column_local_derivative_idx=1,column_basis% &
737  & number_of_derivatives(column_local_node_idx)
738  column_derivative=column_domain_elements%ELEMENTS(interface_element_idx)% &
739  & element_derivatives(column_local_derivative_idx,column_local_node_idx)
740  column_version=column_domain_elements%ELEMENTS(interface_element_idx)% &
741  & elementversions(column_local_derivative_idx,column_local_node_idx)
742  local_column=column_variable%COMPONENTS(column_component_idx)% &
743  & param_to_dof_map%NODE_PARAM2DOF_MAP%NODES(column_node)% &
744  & derivatives(column_derivative)%VERSIONS(column_version)
745  global_column=column_dofs_domain_mapping%LOCAL_TO_GLOBAL_MAP(local_column)
746  !Loop over the components in the dependent variable
747  DO row_component_idx=1,row_variable%NUMBER_OF_COMPONENTS
748  SELECT CASE(row_variable%COMPONENTS(row_component_idx)%INTERPOLATION_TYPE)
749  CASE(field_constant_interpolation)
750  local_row=row_variable%COMPONENTS(row_component_idx)%PARAM_TO_DOF_MAP% &
751  & constant_param2dof_map
752  CALL list_item_add(column_indices_lists(local_row)%PTR,global_column, &
753  & err,error,*999)
754  IF(interface_matrix%HAS_TRANSPOSE) THEN
755  global_row=row_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_row)
756  CALL list_item_add(transpose_column_indices_lists(local_column)%PTR, &
757  & global_row,err,error,*999)
758  ENDIF
759  CASE(field_element_based_interpolation)
760  domain_element=mesh_connectivity% &
761  & element_connectivity(interface_element_idx,interface_mesh_index)% &
762  & coupled_mesh_element_number
763  local_row=row_variable%COMPONENTS(row_component_idx)%PARAM_TO_DOF_MAP% &
764  & element_param2dof_map%ELEMENTS(domain_element)
765  CALL list_item_add(column_indices_lists(local_row)%PTR,global_column, &
766  & err,error,*999)
767  IF(interface_matrix%HAS_TRANSPOSE) THEN
768  global_row=row_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_row)
769  CALL list_item_add(transpose_column_indices_lists(local_column)%PTR, &
770  & global_row,err,error,*999)
771  ENDIF
772  CASE(field_node_based_interpolation)
773  row_domain_elements=>row_variable%COMPONENTS(row_component_idx)%DOMAIN% &
774  & topology%ELEMENTS
775  domain_element=mesh_connectivity%ELEMENT_CONNECTIVITY( &
776  & interface_element_idx,interface_mesh_index)%COUPLED_MESH_ELEMENT_NUMBER
777  row_basis=>row_domain_elements%ELEMENTS(domain_element)%BASIS
778  !Loop over the row DOFs in the domain mesh element
779  DO row_local_node_idx=1,row_basis%NUMBER_OF_NODES
780  row_node=row_domain_elements%ELEMENTS(domain_element)% &
781  & element_nodes(row_local_node_idx)
782  DO row_local_derivative_idx=1,row_basis% &
783  & number_of_derivatives(row_local_node_idx)
784  row_derivative=row_domain_elements%ELEMENTS(domain_element)% &
785  & element_derivatives(row_local_derivative_idx,row_local_node_idx)
786  row_version=row_domain_elements%ELEMENTS(domain_element)% &
787  & elementversions(row_local_derivative_idx,row_local_node_idx)
788  local_row=row_variable%COMPONENTS(row_component_idx)% &
789  & param_to_dof_map%NODE_PARAM2DOF_MAP%NODES(row_node)% &
790  & derivatives(row_derivative)%VERSIONS(row_version)
791  CALL list_item_add(column_indices_lists(local_row)%PTR,global_column, &
792  & err,error,*999)
793  IF(interface_matrix%HAS_TRANSPOSE) THEN
794  global_row=row_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_row)
795  CALL list_item_add(transpose_column_indices_lists(local_column)%PTR, &
796  & global_row,err,error,*999)
797  ENDIF
798  ENDDO !row_local_derivative_idx
799  ENDDO !row_local_node_idx
800  CASE(field_grid_point_based_interpolation)
801  CALL flagerror("Not implemented.",err,error,*999)
802  CASE(field_gauss_point_based_interpolation)
803  CALL flagerror("Not implemented.",err,error,*999)
804  CASE DEFAULT
805  local_error="The row variable interpolation type of "// &
806  & trim(number_to_vstring(row_variable%COMPONENTS(row_component_idx)% &
807  interpolation_type,"*",err,error))//" is invalid."
808  CALL flagerror(local_error,err,error,*999)
809  END SELECT
810  ENDDO !row_component_idx
811  ENDDO !column_local_derivative_idx
812  ENDDO !column_local_node_idx
813  ENDDO !interface_element_idx
814  ELSE
815  CALL flagerror("Only node based fields implemented.",err,error,*999)
816  ENDIF
817  ENDDO !column_component_idx
818  row_indices(1)=1
819  DO local_row=1,row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
820  CALL list_remove_duplicates(column_indices_lists(local_row)%PTR,err,error,*999)
821  CALL list_number_of_items_get(column_indices_lists(local_row)%PTR,number_of_columns, &
822  & err,error,*999)
823  number_of_non_zeros=number_of_non_zeros+number_of_columns
824  row_indices(local_row+1)=number_of_non_zeros+1
825  ENDDO !local_row
826  IF(interface_matrix%HAS_TRANSPOSE) THEN
827  transpose_number_of_non_zeros=0
828  transpose_row_indices(1)=1
829  DO local_column=1,column_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
830  CALL list_remove_duplicates(transpose_column_indices_lists(local_column)%PTR, &
831  & err,error,*999)
832  CALL list_number_of_items_get(transpose_column_indices_lists(local_column)%PTR, &
833  & number_of_columns,err,error,*999)
834  transpose_number_of_non_zeros=transpose_number_of_non_zeros+number_of_columns
835  transpose_row_indices(local_column+1)=transpose_number_of_non_zeros+1
836  ENDDO !local_column
837  !Sanity check - the number of non-zeros should be the same
838  IF(transpose_number_of_non_zeros/=number_of_non_zeros) THEN
839  local_error="Invalid number of non-zeros. The number of non-zeros in the "// &
840  & "transposed matrix ("//trim(number_to_vstring(transpose_number_of_non_zeros, &
841  & "*",err,error))//") does not match the number of non-zeros in the interface "// &
842  & "matrix ("//trim(number_to_vstring(transpose_number_of_non_zeros,"*",err, &
843  & error))//")."
844  CALL flagerror(local_error,err,error,*999)
845  ENDIF
846  ENDIF
847  !Allocate and setup the column locations
848  ALLOCATE(column_indices(number_of_non_zeros),stat=err)
849  IF(err/=0) CALL flagerror("Could not allocate column indices.",err,error,*999)
850  DO local_row=1,row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
851  CALL list_detach_and_destroy(column_indices_lists(local_row)%PTR,number_of_columns, &
852  & columns,err,error,*999)
853  DO column_idx=1,number_of_columns
854  column_indices(row_indices(local_row)+column_idx-1)=columns(column_idx)
855  ENDDO !column_idx
856  DEALLOCATE(columns)
857  ENDDO !local_row
858  IF(interface_matrix%HAS_TRANSPOSE) THEN
859  !Allocate and setup the column locations
860  ALLOCATE(transpose_column_indices(number_of_non_zeros),stat=err)
861  IF(err/=0) &
862  & CALL flagerror("Could not allocate transpose column indices.",err,error,*999)
863  DO local_column=1,column_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL
864  CALL list_detach_and_destroy(transpose_column_indices_lists(local_column)%PTR, &
865  & number_of_rows,transpose_columns,err,error,*999)
866  DO row_idx=1,number_of_rows
867  transpose_column_indices(transpose_row_indices(local_column)+row_idx-1)= &
868  & transpose_columns(row_idx)
869  ENDDO !row_idx
870  DEALLOCATE(transpose_columns)
871  ENDDO !local_column
872  ENDIF
873  IF(diagnostics1) THEN
874  CALL write_string(diagnostic_output_type,"Interface matrix structure:",err,error,*999)
875  CALL write_string_value(diagnostic_output_type,"Interface matrix number : ", &
876  & matrix_number,err,error,*999)
877  CALL write_string_value(diagnostic_output_type," Number of rows = ", &
878  & row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL,err,error,*999)
879  CALL write_string_value(diagnostic_output_type," Number of columns = ", &
880  & column_dofs_domain_mapping%NUMBER_OF_GLOBAL,err,error,*999)
881  CALL write_string_value(diagnostic_output_type," Number of non zeros = ", &
882  & number_of_non_zeros,err,error,*999)
883  IF(row_dofs_domain_mapping%TOTAL_NUMBER_OF_LOCAL* &
884  & column_dofs_domain_mapping%NUMBER_OF_GLOBAL/=0) THEN
885  sparsity=REAL(number_of_non_zeros,dp)/REAL(row_dofs_domain_mapping% &
886  & TOTAL_NUMBER_OF_LOCAL*COLUMN_DOFS_DOMAIN_MAPPING%NUMBER_OF_GLOBAL,DP)*100.0_DP
887  call write_string_fmt_value(diagnostic_output_type," Sparsity (%) = ",sparsity, &
888  & "F6.2",ERR,ERROR,*999)
889  endif
890  CALL write_string_vector(diagnostic_output_type,1,1,row_dofs_domain_mapping% &
891  & total_number_of_local+1,5,5,row_indices, &
892  & '(" Row indices :",5(X,I13))','(28X,5(X,I13))',err,error,*999)
893  CALL write_string_vector(diagnostic_output_type,1,1,number_of_non_zeros,8,8, &
894  & column_indices,'(" Column indices :",5(X,I13))','(28X,5(X,I13))', &
895  & err,error,*999)
896  IF(interface_matrix%HAS_TRANSPOSE) THEN
897  CALL write_string_vector(diagnostic_output_type,1,1,column_dofs_domain_mapping% &
898  & total_number_of_local+1,5,5,transpose_row_indices, &
899  & '(" Transpose row indices :",5(X,I13))','(28X,5(X,I13))',err,error,*999)
900  CALL write_string_vector(diagnostic_output_type,1,1,number_of_non_zeros,8,8, &
901  & transpose_column_indices,'(" Transpose column indices :",5(X,I13))', &
902  & '(28X,5(X,I13))',err,error,*999)
903  ENDIF
904  ENDIF
905  ELSE
906  CALL flagerror("Column dofs parameter mapping is not associated.",err,error,*999)
907  ENDIF
908  ELSE
909  CALL flagerror("Row dofs parameter mapping is not associated.",err,error,*999)
910  ENDIF
911  ELSE
912  CALL flagerror("Column dofs domain mapping is not associated.",err,error,*999)
913  ENDIF
914  ELSE
915  CALL flagerror("Row dofs domain mapping is not associated.",err,error,*999)
916  ENDIF
917  ELSE
918  CALL flagerror("Column field variable is not associated.",err,error,*999)
919  ENDIF
920  ELSE
921  CALL flagerror("Row field variable is not associated.",err,error,*999)
922  ENDIF
923  ELSE
924  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
925  ENDIF
926  ELSE
927  CALL flagerror("Interface condition interface is not associated.",err,error,*999)
928  ENDIF
929  ELSE
930  CALL flagerror("Interface condition is not associated.",err,error,*999)
931  ENDIF
932  ELSE
933  CALL flagerror("Interface mapping is not associated.",err,error,*999)
934  ENDIF
935  ELSE
936  CALL flagerror("Interface equations is not associated.",err,error,*999)
937  ENDIF
938  ELSE
939  CALL flagerror("Interface matrices is not associated.",err,error,*999)
940  ENDIF
941  CASE DEFAULT
942  local_error="The matrix storage type of "// &
943  & trim(number_to_vstring(interface_matrix%STORAGE_TYPE,"*",err,error))//" is invalid."
944  CALL flagerror(local_error,err,error,*999)
945  END SELECT
946  CASE DEFAULT
947  local_error="The matrix structure type of "// &
948  & trim(number_to_vstring(interface_matrix%STRUCTURE_TYPE,"*",err,error))//" is invalid."
949  CALL flagerror(local_error,err,error,*998)
950  END SELECT
951  ELSE
952  CALL flagerror("Transpose column indices is already associated.",err,error,*998)
953  ENDIF
954  ELSE
955  CALL flagerror("Transpose row indieces is already associated.",err,error,*998)
956  ENDIF
957  ELSE
958  CALL flagerror("Column indices is already associated.",err,error,*998)
959  ENDIF
960  ELSE
961  CALL flagerror("Row indieces is already associated.",err,error,*998)
962  ENDIF
963  ELSE
964  CALL flagerror("Interface matrix is not associated.",err,error,*998)
965  ENDIF
966 
967  exits("INTERFACE_MATRIX_STRUCTURE_CALCULATE")
968  RETURN
969 999 IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
970  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
971  IF(ASSOCIATED(transpose_row_indices)) DEALLOCATE(transpose_row_indices)
972  IF(ASSOCIATED(transpose_column_indices)) DEALLOCATE(transpose_column_indices)
973  IF(ALLOCATED(columns)) DEALLOCATE(columns)
974  IF(ALLOCATED(transpose_columns)) DEALLOCATE(transpose_columns)
975  IF(ALLOCATED(column_indices_lists)) THEN
976  DO local_row=1,SIZE(column_indices_lists,1)
977  IF(ASSOCIATED(column_indices_lists(local_row)%PTR)) &
978  & CALL list_destroy(column_indices_lists(local_row)%PTR,dummy_err,dummy_error,*998)
979  ENDDO !local_row
980  DEALLOCATE(column_indices_lists)
981  ENDIF
982  IF(ALLOCATED(transpose_column_indices_lists)) THEN
983  DO local_column=1,SIZE(transpose_column_indices_lists,1)
984  IF(ASSOCIATED(transpose_column_indices_lists(local_column)%PTR)) &
985  & CALL list_destroy(transpose_column_indices_lists(local_column)%PTR,dummy_err,dummy_error,*998)
986  ENDDO !local_row
987  DEALLOCATE(transpose_column_indices_lists)
988  ENDIF
989 998 errorsexits("INTERFACE_MATRIX_STRUCTURE_CALCULATE",err,error)
990  RETURN 1
991 
992  END SUBROUTINE interface_matrix_structure_calculate
993 
994  !
995  !================================================================================================================================
996  !
997 
999  SUBROUTINE interface_matrices_create_finish(INTERFACE_MATRICES,ERR,ERROR,*)
1000 
1001  !Argument variables
1002  TYPE(interface_matrices_type), POINTER :: interface_matrices
1003  INTEGER(INTG), INTENT(OUT) :: err
1004  TYPE(varying_string), INTENT(OUT) :: error
1005  !Local Variables
1006  INTEGER(INTG) :: dummy_err,matrix_idx,number_of_non_zeros
1007  INTEGER(INTG), POINTER :: row_indices(:),column_indices(:),transpose_row_indices(:),transpose_column_indices(:)
1008  TYPE(domain_mapping_type), POINTER :: row_domain_map,column_domain_map
1009  TYPE(interface_mapping_type), POINTER :: interface_mapping
1010  TYPE(interface_matrix_type), POINTER :: interface_matrix
1011  TYPE(interface_rhs_type), POINTER :: rhs_vector
1012  TYPE(varying_string) :: dummy_error,local_error
1013 
1014  NULLIFY(row_indices)
1015  NULLIFY(column_indices)
1016  NULLIFY(transpose_row_indices)
1017  NULLIFY(transpose_column_indices)
1018 
1019  NULLIFY(row_domain_map)
1020  NULLIFY(column_domain_map)
1021 
1022  enters("INTERFACE_MATRICES_CREATE_FINISH",err,error,*998)
1023 
1024  IF(ASSOCIATED(interface_matrices)) THEN
1025  IF(interface_matrices%INTERFACE_MATRICES_FINISHED) THEN
1026  CALL flagerror("Interface matrices have already been finished.",err,error,*998)
1027  ELSE
1028  interface_mapping=>interface_matrices%INTERFACE_MAPPING
1029  IF(ASSOCIATED(interface_mapping)) THEN
1030  column_domain_map=>interface_mapping%COLUMN_DOFS_MAPPING
1031  IF(ASSOCIATED(column_domain_map)) THEN
1032  !Now create the individual interface matrices
1033  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
1034  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
1035  IF(ASSOCIATED(interface_matrix)) THEN
1036  row_domain_map=>interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%ROW_DOFS_MAPPING
1037  IF(ASSOCIATED(row_domain_map)) THEN
1038  !Create the distributed equations matrix
1039  CALL distributed_matrix_create_start(row_domain_map,column_domain_map,interface_matrices% &
1040  & matrices(matrix_idx)%PTR%MATRIX,err,error,*999)
1041  CALL distributed_matrix_data_type_set(interface_matrix%MATRIX,distributed_matrix_vector_dp_type,err,error,*999)
1042  CALL distributed_matrix_storage_type_set(interface_matrix%MATRIX,interface_matrix%STORAGE_TYPE,err,error,*999)
1043  IF(interface_matrix%HAS_TRANSPOSE) THEN
1044  CALL distributed_matrix_create_start(column_domain_map,row_domain_map,interface_matrices% &
1045  & matrices(matrix_idx)%PTR%MATRIX_TRANSPOSE,err,error,*999)
1046  CALL distributed_matrix_data_type_set(interface_matrix%MATRIX_TRANSPOSE,distributed_matrix_vector_dp_type, &
1047  & err,error,*999)
1048  CALL distributed_matrix_storage_type_set(interface_matrix%MATRIX_TRANSPOSE,interface_matrix%STORAGE_TYPE, &
1049  & err,error,*999)
1050  ENDIF
1051  !Calculate and set the matrix structure/sparsity pattern
1052  IF(interface_matrix%STORAGE_TYPE/=distributed_matrix_block_storage_type.AND. &
1053  & interface_matrix%STORAGE_TYPE/=distributed_matrix_diagonal_storage_type) THEN
1054  CALL interface_matrix_structure_calculate(interface_matrix,number_of_non_zeros,row_indices,column_indices, &
1055  & transpose_row_indices,transpose_column_indices,err,error,*999)
1056  CALL distributed_matrix_number_non_zeros_set(interface_matrix%MATRIX,number_of_non_zeros,err,error,*999)
1057  CALL distributed_matrix_storage_locations_set(interface_matrix%MATRIX,row_indices,column_indices, &
1058  & err,error,*999)
1059  IF(interface_matrix%HAS_TRANSPOSE) THEN
1060  CALL distributed_matrix_number_non_zeros_set(interface_matrix%MATRIX_TRANSPOSE,number_of_non_zeros, &
1061  & err,error,*999)
1062  CALL distributed_matrix_storage_locations_set(interface_matrix%MATRIX_TRANSPOSE,transpose_row_indices, &
1063  & transpose_column_indices,err,error,*999)
1064  ENDIF
1065  IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
1066  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
1067  IF(ASSOCIATED(transpose_row_indices)) DEALLOCATE(transpose_row_indices)
1068  IF(ASSOCIATED(transpose_column_indices)) DEALLOCATE(transpose_column_indices)
1069  ENDIF
1070  CALL distributed_matrix_create_finish(interface_matrix%MATRIX,err,error,*999)
1071  IF(interface_matrix%HAS_TRANSPOSE) THEN
1072  CALL distributed_matrix_create_finish(interface_matrix%MATRIX_TRANSPOSE,err,error,*999)
1073  ENDIF
1074  ELSE
1075  local_error="Row domain map for interface matrix number "// &
1076  & trim(number_to_vstring(matrix_idx,"*",err,error))//" is not associated."
1077  CALL flagerror(local_error,err,error,*999)
1078  ENDIF
1079  ELSE
1080  local_error="Interface matrix for matrix number "//trim(number_to_vstring(matrix_idx,"*",err,error))// &
1081  & " is not associated."
1082  CALL flagerror(local_error,err,error,*999)
1083  ENDIF
1084  ENDDO !matrix_idx
1085  rhs_vector=>interface_matrices%RHS_VECTOR
1086  IF(ASSOCIATED(rhs_vector)) THEN
1087  !Set up the interface RHS vector
1088  CALL distributed_vector_create_start(column_domain_map,interface_matrices%RHS_VECTOR%RHS_VECTOR,err,error,*999)
1089  CALL distributed_vector_data_type_set(rhs_vector%RHS_VECTOR,matrix_vector_dp_type,err,error,*999)
1090  CALL distributed_vector_create_finish(rhs_vector%RHS_VECTOR,err,error,*999)
1091  ENDIF
1092  !Finish up
1093  interface_matrices%INTERFACE_MATRICES_FINISHED=.true.
1094  ELSE
1095  CALL flagerror("Column domain map is not associated.",err,error,*999)
1096  ENDIF
1097  ELSE
1098  CALL flagerror("Interface mapping is not associated.",err,error,*998)
1099  ENDIF
1100  ENDIF
1101  ELSE
1102  CALL flagerror("Interface matrices is not associated.",err,error,*998)
1103  ENDIF
1104 
1105  exits("INTERFACE_MATRICES_CREATE_FINISH")
1106  RETURN
1107 999 IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
1108  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
1109  IF(ASSOCIATED(transpose_row_indices)) DEALLOCATE(transpose_row_indices)
1110  IF(ASSOCIATED(transpose_column_indices)) DEALLOCATE(transpose_column_indices)
1111  CALL interface_matrices_finalise(interface_matrices,dummy_err,dummy_error,*998)
1112 998 errorsexits("INTERFACE_MATRICES_CREATE_FINISH",err,error)
1113  RETURN 1
1114  END SUBROUTINE interface_matrices_create_finish
1115 
1116  !
1117  !================================================================================================================================
1118  !
1119 
1121  SUBROUTINE interface_matrices_create_start(INTERFACE_EQUATIONS,INTERFACE_MATRICES,ERR,ERROR,*)
1122 
1123  !Argument variables
1124  TYPE(interface_equations_type), POINTER :: interface_equations
1125  TYPE(interface_matrices_type), POINTER :: interface_matrices
1126  INTEGER(INTG), INTENT(OUT) :: err
1127  TYPE(varying_string), INTENT(OUT) :: error
1128  !Local Variables
1129 
1130  enters("INTERFACE_MATRICES_CREATE_START",err,error,*999)
1131 
1132  IF(ASSOCIATED(interface_equations)) THEN
1133  IF(interface_equations%INTERFACE_EQUATIONS_FINISHED) THEN
1134  IF(ASSOCIATED(interface_matrices)) THEN
1135  CALL flagerror("Interface matrices is already associated.",err,error,*999)
1136  ELSE
1137  NULLIFY(interface_matrices)
1138  !Initialise the interface matrices
1139  CALL interface_matrices_initialise(interface_equations,err,error,*999)
1140  !Return the pointer
1141  interface_matrices=>interface_equations%INTERFACE_MATRICES
1142  ENDIF
1143  ELSE
1144  CALL flagerror("Interface equations has not been finished.",err,error,*999)
1145  ENDIF
1146  ELSE
1147  CALL flagerror("Interface equations is not associated.",err,error,*999)
1148  ENDIF
1149 
1150  exits("INTERFACE_MATRICES_CREATE_START")
1151  RETURN
1152 999 errorsexits("INTERFACE_MATRICES_CREATE_START",err,error)
1153  RETURN 1
1154 
1155  END SUBROUTINE interface_matrices_create_start
1156 
1157  !
1158  !================================================================================================================================
1159  !
1160 
1162  SUBROUTINE interface_matrices_destroy(INTERFACE_MATRICES,ERR,ERROR,*)
1163 
1164  !Argument variables
1165  TYPE(interface_matrices_type), POINTER :: interface_matrices
1166  INTEGER(INTG), INTENT(OUT) :: err
1167  TYPE(varying_string), INTENT(OUT) :: error
1168  !Local Variables
1169 
1170  enters("INTERFACE_MATRICES_DESTROY",err,error,*999)
1171 
1172  IF(ASSOCIATED(interface_matrices)) THEN
1173  CALL interface_matrices_finalise(interface_matrices,err,error,*999)
1174  ELSE
1175  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1176  ENDIF
1177 
1178  exits("INTERFACE_MATRICES_DESTROY")
1179  RETURN
1180 999 errorsexits("INTERFACE_MATRICES_DESTROY",err,error)
1181  RETURN 1
1182 
1183  END SUBROUTINE interface_matrices_destroy
1184 
1185  !
1186  !================================================================================================================================
1187  !
1188 
1190  SUBROUTINE interface_matrices_finalise(INTERFACE_MATRICES,ERR,ERROR,*)
1191 
1192  !Argument variables
1193  TYPE(interface_matrices_type), POINTER :: interface_matrices
1194  INTEGER(INTG), INTENT(OUT) :: err
1195  TYPE(varying_string), INTENT(OUT) :: error
1196  !Local Variables
1197  INTEGER(INTG) :: matrix_idx
1198 
1199  enters("INTERFACE_MATRICES_FINALISE",err,error,*999)
1200 
1201  IF(ASSOCIATED(interface_matrices)) THEN
1202  IF(ALLOCATED(interface_matrices%MATRICES)) THEN
1203  DO matrix_idx=1,SIZE(interface_matrices%MATRICES,1)
1204  CALL interface_matrix_finalise(interface_matrices%MATRICES(matrix_idx)%PTR,err,error,*999)
1205  ENDDO !matrix_idx
1206  DEALLOCATE(interface_matrices%MATRICES)
1207  ENDIF
1208  CALL interface_matrices_rhs_finalise(interface_matrices%RHS_VECTOR,err,error,*999)
1209  DEALLOCATE(interface_matrices)
1210  ENDIF
1211 
1212  exits("INTERFACE_MATRICES_FINALISE")
1213  RETURN
1214 999 errorsexits("INTERFACE_MATRICES_FINALISE",err,error)
1215  RETURN 1
1216  END SUBROUTINE interface_matrices_finalise
1217 
1218  !
1219  !================================================================================================================================
1220  !
1221 
1223  SUBROUTINE interface_matrices_initialise(INTERFACE_EQUATIONS,ERR,ERROR,*)
1224 
1225  !Argument variables
1226  TYPE(interface_equations_type), POINTER :: interface_equations
1227  INTEGER(INTG), INTENT(OUT) :: err
1228  TYPE(varying_string), INTENT(OUT) :: error
1229  !Local Variables
1230  INTEGER(INTG) :: dummy_err,matrix_idx
1231  TYPE(interface_mapping_type), POINTER :: interface_mapping
1232  TYPE(varying_string) :: dummy_error
1233 
1234  enters("INTERFACE_MATRICES_INITIALISE",err,error,*998)
1235 
1236  IF(ASSOCIATED(interface_equations)) THEN
1237  IF(ASSOCIATED(interface_equations%INTERFACE_MATRICES)) THEN
1238  CALL flagerror("Interface matrices is already associated for this interface equations.",err,error,*998)
1239  ELSE
1240  interface_mapping=>interface_equations%INTERFACE_MAPPING
1241  IF(ASSOCIATED(interface_mapping)) THEN
1242  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1243  ALLOCATE(interface_equations%INTERFACE_MATRICES,stat=err)
1244  IF(err/=0) CALL flagerror("Could not allocate interface equations interface matrices.",err,error,*999)
1245  interface_equations%INTERFACE_MATRICES%INTERFACE_EQUATIONS=>interface_equations
1246  interface_equations%INTERFACE_MATRICES%INTERFACE_MATRICES_FINISHED=.false.
1247  interface_equations%INTERFACE_MATRICES%INTERFACE_MAPPING=>interface_mapping
1248  NULLIFY(interface_equations%INTERFACE_MATRICES%SOLVER_MAPPING)
1249  interface_equations%INTERFACE_MATRICES%NUMBER_OF_COLUMNS=interface_mapping%NUMBER_OF_COLUMNS
1250  interface_equations%INTERFACE_MATRICES%TOTAL_NUMBER_OF_COLUMNS=interface_mapping%TOTAL_NUMBER_OF_COLUMNS
1251  interface_equations%INTERFACE_MATRICES%NUMBER_OF_GLOBAL_COLUMNS=interface_mapping%NUMBER_OF_GLOBAL_COLUMNS
1252  NULLIFY(interface_equations%INTERFACE_MATRICES%RHS_VECTOR)
1253  !Allocate and initialise the matrices
1254  interface_equations%INTERFACE_MATRICES%NUMBER_OF_INTERFACE_MATRICES=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
1255  ALLOCATE(interface_equations%INTERFACE_MATRICES%MATRICES(interface_equations%INTERFACE_MATRICES% &
1256  & number_of_interface_matrices),stat=err)
1257  IF(err/=0) CALL flagerror("Could not allocate interface matrices matrices.",err,error,*999)
1258  DO matrix_idx=1,interface_equations%INTERFACE_MATRICES%NUMBER_OF_INTERFACE_MATRICES
1259  NULLIFY(interface_equations%INTERFACE_MATRICES%MATRICES(matrix_idx)%PTR)
1260  CALL interface_matrix_initialise(interface_equations%INTERFACE_MATRICES,matrix_idx,err,error,*999)
1261  ENDDO !matrix_idx
1262  CALL interface_matrices_rhs_initialise(interface_equations%INTERFACE_MATRICES,err,error,*999)
1263  ELSE
1264  CALL flagerror("Interface mapping has not been finished.",err,error,*999)
1265  ENDIF
1266  ELSE
1267  CALL flagerror("Interface equations interface mapping is not associated.",err,error,*998)
1268  ENDIF
1269  ENDIF
1270  ELSE
1271  CALL flagerror("Interface equations is not associated.",err,error,*998)
1272  ENDIF
1273 
1274  exits("INTERFACE_MATRICES_INITIALISE")
1275  RETURN
1276 999 CALL interface_matrices_finalise(interface_equations%INTERFACE_MATRICES,dummy_err,dummy_error,*998)
1277 998 errorsexits("INTERFACE_MATRICES_INITIALISE",err,error)
1278  RETURN 1
1279  END SUBROUTINE interface_matrices_initialise
1280 
1281  !
1282  !================================================================================================================================
1283  !
1284 
1286  SUBROUTINE interface_matrices_output(ID,INTERFACE_MATRICES,ERR,ERROR,*)
1287 
1288  !Argument variables
1289  INTEGER(INTG), INTENT(IN) :: id
1290  TYPE(interface_matrices_type), POINTER :: interface_matrices
1291  INTEGER(INTG), INTENT(OUT) :: err
1292  TYPE(varying_string), INTENT(OUT) :: error
1293  !Local Variables
1294  INTEGER(INTG) :: matrix_idx
1295  TYPE(interface_matrix_type), POINTER :: interface_matrix
1296  TYPE(interface_rhs_type), POINTER :: rhs_vector
1297 
1298  enters("INTERFACE_MATRICES_OUTPUT",err,error,*999)
1299 
1300  IF(ASSOCIATED(interface_matrices)) THEN
1301  IF(interface_matrices%INTERFACE_MATRICES_FINISHED) THEN
1302  CALL write_string(id,"Interface matrices:",err,error,*999)
1303  CALL write_string_value(id,"Number of interface matrices = ",interface_matrices%NUMBER_OF_INTERFACE_MATRICES, &
1304  & err,error,*999)
1305  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
1306  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
1307  IF(ASSOCIATED(interface_matrix)) THEN
1308  CALL write_string_value(id,"Interface matrix : ",matrix_idx,err,error,*999)
1309  CALL write_string(id,"Standard matrix:",err,error,*999)
1310  CALL distributed_matrix_output(id,interface_matrix%MATRIX,err,error,*999)
1311  IF(interface_matrix%HAS_TRANSPOSE) THEN
1312  CALL write_string(id,"Transposed matrix:",err,error,*999)
1313  CALL distributed_matrix_output(id,interface_matrix%MATRIX_TRANSPOSE,err,error,*999)
1314  ENDIF
1315  ELSE
1316  CALL flagerror("Interface matrix is not associated.",err,error,*999)
1317  ENDIF
1318  ENDDO !matrix_idx
1319  rhs_vector=>interface_matrices%RHS_VECTOR
1320  IF(ASSOCIATED(rhs_vector)) THEN
1321  CALL write_string(id,"Interface RHS vector:",err,error,*999)
1322  CALL distributed_vector_output(id,rhs_vector%RHS_VECTOR,err,error,*999)
1323  ENDIF
1324  ELSE
1325  CALL flagerror("Interface matrices have not been finished.",err,error,*999)
1326  ENDIF
1327  ELSE
1328  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1329  ENDIF
1330 
1331  exits("INTERFACE_MATRICES_OUTPUT")
1332  RETURN
1333 999 errorsexits("INTERFACE_MATRICES_OUTPUT",err,error)
1334  RETURN 1
1335 
1336  END SUBROUTINE interface_matrices_output
1337 
1338  !
1339  !================================================================================================================================
1340  !
1341 
1343  SUBROUTINE interface_matrices_rhs_finalise(RHS_VECTOR,ERR,ERROR,*)
1344 
1345  !Argument variables
1346  TYPE(interface_rhs_type), POINTER :: rhs_vector
1347  INTEGER(INTG), INTENT(OUT) :: err
1348  TYPE(varying_string), INTENT(OUT) :: error
1349  !Local Variables
1350 
1351  enters("INTERFACE_MATRICES_RHS_FINALISE",err,error,*999)
1352 
1353  IF(ASSOCIATED(rhs_vector)) THEN
1354  IF(ASSOCIATED(rhs_vector%RHS_VECTOR)) CALL distributed_vector_destroy(rhs_vector%RHS_VECTOR,err,error,*999)
1355  CALL equations_matrices_element_vector_finalise(rhs_vector%ELEMENT_VECTOR,err,error,*999)
1356  DEALLOCATE(rhs_vector)
1357  ENDIF
1358 
1359  exits("INTERFACE_MATRICES_RHS_FINALISE")
1360  RETURN
1361 999 errorsexits("INTERFACE_MATRICES_RHS_FINALISE",err,error)
1362  RETURN 1
1363  END SUBROUTINE interface_matrices_rhs_finalise
1364 
1365  !
1366  !================================================================================================================================
1367  !
1368 
1370  SUBROUTINE interface_matrices_rhs_initialise(INTERFACE_MATRICES,ERR,ERROR,*)
1371 
1372  !Argument variables
1373  TYPE(interface_matrices_type), POINTER :: interface_matrices
1374  INTEGER(INTG), INTENT(OUT) :: err
1375  TYPE(varying_string), INTENT(OUT) :: error
1376  !Local Variables
1377  INTEGER(INTG) :: dummy_err
1378  TYPE(interface_mapping_type), POINTER :: interface_mapping
1379  TYPE(interface_mapping_rhs_type), POINTER :: rhs_mapping
1380  TYPE(varying_string) :: dummy_error
1381 
1382  enters("INTERFACE_MATRICES_RHS_INITIALISE",err,error,*998)
1383 
1384  IF(ASSOCIATED(interface_matrices)) THEN
1385  interface_mapping=>interface_matrices%INTERFACE_MAPPING
1386  IF(ASSOCIATED(interface_mapping)) THEN
1387  rhs_mapping=>interface_mapping%RHS_MAPPING
1388  IF(ASSOCIATED(rhs_mapping)) THEN
1389  IF(ASSOCIATED(interface_matrices%RHS_VECTOR)) THEN
1390  CALL flagerror("Interface matrices RHS vector is already associated.",err,error,*998)
1391  ELSE
1392  ALLOCATE(interface_matrices%RHS_VECTOR,stat=err)
1393  IF(err/=0) CALL flagerror("Could not allocate interface matrices RHS vector.",err,error,*999)
1394  interface_matrices%RHS_VECTOR%UPDATE_VECTOR=.true.
1395  interface_matrices%RHS_VECTOR%FIRST_ASSEMBLY=.true.
1396  NULLIFY(interface_matrices%RHS_VECTOR%RHS_VECTOR)
1397  CALL equationsmatrices_elementvectorinitialise(interface_matrices%RHS_VECTOR%ELEMENT_VECTOR,err,error,*999)
1398  ENDIF
1399  ENDIF
1400  ELSE
1401  CALL flagerror("Interface matrices equation mapping is not associated.",err,error,*998)
1402  ENDIF
1403  ELSE
1404  CALL flagerror("Interface matrices is not associated.",err,error,*998)
1405  ENDIF
1406 
1407  exits("INTERFACE_MATRICES_RHS_INITIALISE")
1408  RETURN
1409 999 CALL interface_matrices_rhs_finalise(interface_matrices%RHS_VECTOR,dummy_err,dummy_error,*998)
1410 998 errorsexits("INTERFACE_MATRICES_RHS_INITIALISE",err,error)
1411  RETURN 1
1412  END SUBROUTINE interface_matrices_rhs_initialise
1413 
1414  !
1415  !================================================================================================================================
1416  !
1417 
1419  SUBROUTINE interface_matrices_storage_type_set(INTERFACE_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
1420 
1421  !Argument variables
1422  TYPE(interface_matrices_type), POINTER :: interface_matrices
1423  INTEGER(INTG), INTENT(IN) :: storage_type(:)
1424  INTEGER(INTG), INTENT(OUT) :: err
1425  TYPE(varying_string), INTENT(OUT) :: error
1426  !Local Variables
1427  INTEGER(INTG) :: matrix_idx
1428  TYPE(interface_matrix_type), POINTER :: interface_matrix
1429  TYPE(varying_string) :: local_error
1430 
1431  enters("INTERFACE_MATRICES_STORAGE_TYPE_SET",err,error,*999)
1432 
1433  IF(ASSOCIATED(interface_matrices)) THEN
1434  IF(interface_matrices%INTERFACE_MATRICES_FINISHED) THEN
1435  CALL flagerror("Interface matrices have been finished.",err,error,*999)
1436  ELSE
1437  IF(SIZE(storage_type,1)==interface_matrices%NUMBER_OF_INTERFACE_MATRICES) THEN
1438  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
1439  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
1440  IF(ASSOCIATED(interface_matrix)) THEN
1441  SELECT CASE(storage_type(matrix_idx))
1442  CASE(distributed_matrix_block_storage_type)
1443  interface_matrix%STORAGE_TYPE=distributed_matrix_block_storage_type
1444  CASE(distributed_matrix_diagonal_storage_type)
1445  interface_matrix%STORAGE_TYPE=distributed_matrix_diagonal_storage_type
1446  CASE(distributed_matrix_column_major_storage_type)
1447  interface_matrix%STORAGE_TYPE=distributed_matrix_column_major_storage_type
1448  CASE(distributed_matrix_row_major_storage_type)
1449  interface_matrix%STORAGE_TYPE=distributed_matrix_row_major_storage_type
1450  CASE(distributed_matrix_compressed_row_storage_type)
1451  interface_matrix%STORAGE_TYPE=distributed_matrix_compressed_row_storage_type
1452  CASE(distributed_matrix_compressed_column_storage_type)
1453  interface_matrix%STORAGE_TYPE=distributed_matrix_compressed_column_storage_type
1454  CASE(distributed_matrix_row_column_storage_type)
1455  interface_matrix%STORAGE_TYPE=distributed_matrix_row_column_storage_type
1456  CASE DEFAULT
1457  local_error="The specified storage type of "//trim(number_to_vstring(storage_type(matrix_idx),"*",err,error))// &
1458  & " for interface matrix number "//trim(number_to_vstring(matrix_idx,"*",err,error))//" is invalid."
1459  CALL flagerror(local_error,err,error,*999)
1460  END SELECT
1461  ELSE
1462  CALL flagerror("Interface matrix is not associated.",err,error,*999)
1463  ENDIF
1464  ENDDO !matrix_idx
1465  ELSE
1466  local_error="The size of the storage type array ("//trim(number_to_vstring(SIZE(storage_type,1),"*",err,error))// &
1467  & ") is not equal to the number of interface matrices ("// &
1468  & trim(number_to_vstring(interface_matrices%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//")."
1469  CALL flagerror(local_error,err,error,*999)
1470  ENDIF
1471  ENDIF
1472  ELSE
1473  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1474  ENDIF
1475 
1476  exits("INTERFACE_MATRICES_STORAGE_TYPE_SET")
1477  RETURN
1478 999 errorsexits("INTERFACE_MATRICES_STORAGE_TYPE_SET",err,error)
1479  RETURN 1
1480 
1481  END SUBROUTINE interface_matrices_storage_type_set
1482 
1483  !
1484  !================================================================================================================================
1485  !
1486 
1488  SUBROUTINE interface_matrices_structure_type_set(INTERFACE_MATRICES,STRUCTURE_TYPE,ERR,ERROR,*)
1489 
1490  !Argument variables
1491  TYPE(interface_matrices_type), POINTER :: interface_matrices
1492  INTEGER(INTG), INTENT(IN) :: structure_type(:)
1493  INTEGER(INTG), INTENT(OUT) :: err
1494  TYPE(varying_string), INTENT(OUT) :: error
1495  !Local Variables
1496  INTEGER(INTG) :: matrix_idx
1497  TYPE(interface_matrix_type), POINTER :: interface_matrix
1498  TYPE(varying_string) :: local_error
1499 
1500  enters("INTERFACE_MATRICES_STRUCTURE_TYPE_SET",err,error,*999)
1501 
1502  IF(ASSOCIATED(interface_matrices)) THEN
1503  IF(interface_matrices%INTERFACE_MATRICES_FINISHED) THEN
1504  CALL flagerror("Interface matrices have been finished.",err,error,*999)
1505  ELSE
1506  IF(SIZE(structure_type,1)==interface_matrices%NUMBER_OF_INTERFACE_MATRICES) THEN
1507  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
1508  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
1509  IF(ASSOCIATED(interface_matrix)) THEN
1510  SELECT CASE(structure_type(matrix_idx))
1511  CASE(interface_matrix_no_structure)
1512  interface_matrix%STRUCTURE_TYPE=interface_matrix_no_structure
1513  CASE(interface_matrix_fem_structure)
1514  interface_matrix%STRUCTURE_TYPE=interface_matrix_fem_structure
1515  CASE DEFAULT
1516  local_error="The specified strucutre type of "// &
1517  & trim(number_to_vstring(structure_type(matrix_idx),"*",err,error))//" for interface matrix number "// &
1518  & trim(number_to_vstring(matrix_idx,"*",err,error))//" is invalid."
1519  CALL flagerror(local_error,err,error,*999)
1520  END SELECT
1521  ELSE
1522  CALL flagerror("Interface matrix is not associated.",err,error,*999)
1523  ENDIF
1524  ENDDO !matrix_idx
1525  ELSE
1526  local_error="The size of the structure type array ("//trim(number_to_vstring(SIZE(structure_type,1),"*",err,error))// &
1527  & ") is not equal to the number of interface matrices ("// &
1528  & trim(number_to_vstring(interface_matrices%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//")."
1529  CALL flagerror(local_error,err,error,*999)
1530  ENDIF
1531  ENDIF
1532  ELSE
1533  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1534  ENDIF
1535 
1536  exits("INTERFACE_MATRICES_STRUCTURE_TYPE_SET")
1537  RETURN
1538 999 errorsexits("INTERFACE_MATRICES_STRUCTURE_TYPE_SET",err,error)
1539  RETURN 1
1540  END SUBROUTINE interface_matrices_structure_type_set
1541 
1542  !
1543  !================================================================================================================================
1544  !
1545 
1547  SUBROUTINE interface_matrices_values_initialise(INTERFACE_MATRICES,VALUE,ERR,ERROR,*)
1548 
1549  !Argument variables
1550  TYPE(interface_matrices_type), POINTER :: interface_matrices
1551  REAL(DP), INTENT(IN) :: VALUE
1552  INTEGER(INTG), INTENT(OUT) :: err
1553  TYPE(varying_string), INTENT(OUT) :: error
1554  !Local Variables
1555  INTEGER(INTG) :: matrix_idx
1556  TYPE(interface_matrix_type), POINTER :: interface_matrix
1557  TYPE(interface_rhs_type), POINTER :: rhs_vector
1558 
1559  enters("INTERFACE_MATRICES_VALUES_INITIALISE",err,error,*999)
1560 
1561  IF(ASSOCIATED(interface_matrices)) THEN
1562  DO matrix_idx=1,interface_matrices%NUMBER_OF_INTERFACE_MATRICES
1563  interface_matrix=>interface_matrices%MATRICES(matrix_idx)%PTR
1564  IF(ASSOCIATED(interface_matrix)) THEN
1565  IF(interface_matrix%UPDATE_MATRIX) THEN
1566  CALL distributed_matrix_all_values_set(interface_matrix%MATRIX,VALUE,err,error,*999)
1567  IF(interface_matrix%HAS_TRANSPOSE) THEN
1568  CALL distributed_matrix_all_values_set(interface_matrix%MATRIX_TRANSPOSE,VALUE,err,error,*999)
1569  ENDIF
1570  ENDIF
1571  ELSE
1572  CALL flagerror("Interface matrix is not associated.",err,error,*999)
1573  ENDIF
1574  ENDDO !matrix_idx
1575  rhs_vector=>interface_matrices%RHS_VECTOR
1576  IF(ASSOCIATED(rhs_vector)) THEN
1577  IF(rhs_vector%UPDATE_VECTOR) THEN
1578  CALL distributed_vector_all_values_set(rhs_vector%RHS_VECTOR,VALUE,err,error,*999)
1579  ENDIF
1580  ENDIF
1581  ELSE
1582  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1583  ENDIF
1584 
1585  exits("INTERFACE_MATRICES_VALUES_INITIALISE")
1586  RETURN
1587 999 errorsexits("INTERFACE_MATRICES_VALUES_INITIALISE",err,error)
1588  RETURN 1
1589  END SUBROUTINE interface_matrices_values_initialise
1590 
1591  !
1592  !================================================================================================================================
1593  !
1594 
1595  SUBROUTINE interfacematrix_timedependencetypeset(InterfaceCondition, &
1596  & interfacematrixindex,istranspose,timedependencetype,err,error,*)
1597 
1598  !Argument variables
1599  TYPE(interface_condition_type), POINTER :: interfacecondition
1600  INTEGER(INTG), INTENT(IN) :: interfacematrixindex
1601  LOGICAL, INTENT(IN) :: istranspose
1602  INTEGER(INTG), INTENT(IN) :: timedependencetype
1603  INTEGER(INTG), INTENT(OUT) :: err
1604  TYPE(varying_string), INTENT(OUT) :: error
1605 
1606  !Local variables
1607  TYPE(interface_equations_type), POINTER :: interfaceequations
1608  TYPE(interface_matrices_type), POINTER :: interfacematrices
1609  TYPE(interface_matrix_type), POINTER :: interfacematrix
1610  TYPE(varying_string) :: local_error
1611 
1612  enters("InterfaceMatrix_TimeDependenceTypeSet",err,error,*999)
1613 
1614  IF(ASSOCIATED(interfacecondition)) THEN
1615  interfaceequations=>interfacecondition%INTERFACE_EQUATIONS
1616  IF(ASSOCIATED(interfaceequations)) THEN
1617  interfacematrices=>interfaceequations%INTERFACE_MATRICES
1618  IF(ASSOCIATED(interfacematrices)) THEN
1619  interfacematrix=>interfacematrices%MATRICES(interfacematrixindex)%PTR
1620  IF(ASSOCIATED(interfacematrix)) THEN
1621  IF(.NOT.istranspose) THEN
1622  interfacematrix%INTERFACE_MATRIX_TIME_DEPENDENCE_TYPE=timedependencetype
1623  ELSE
1624  IF(interfacematrix%HAS_TRANSPOSE) THEN
1625  interfacematrix%INTERFACE_MATRIX_TRANSPOSE_TIME_DEPENDENCE_TYPE=timedependencetype
1626  ELSE
1627  local_error="Interface matrices has_transpose flag is .false. but interface matrix type is transpose."
1628  CALL flagerror(local_error,err,error,*999)
1629  ENDIF
1630  ENDIF
1631  ELSE
1632  CALL flagerror("Interface matrix is not associated",err,error,*999)
1633  ENDIF
1634  ELSE
1635  CALL flagerror("Interface matrices not associated.",err,error,*999)
1636  ENDIF
1637  ELSE
1638  CALL flagerror("Interface equations not associated.",err,error,*999)
1639  ENDIF
1640  ELSE
1641  CALL flagerror("Interface condition is not associated.",err,error,*999)
1642  ENDIF
1643 
1644  exits("InterfaceMatrix_TimeDependenceTypeSet")
1645  RETURN
1646 999 errorsexits("InterfaceMatrix_TimeDependenceTypeSet",err,error)
1647  RETURN 1
1648  END SUBROUTINE interfacematrix_timedependencetypeset
1649 
1650  !
1651  !================================================================================================================================
1652  !
1653 
1654  SUBROUTINE interfacematrix_timedependencetypeget(InterfaceCondition, &
1655  & interfacematrixindex,istranspose,timedependencetype,err,error,*)
1656 
1657  !Argument variables
1658  TYPE(interface_condition_type), POINTER :: interfacecondition
1659  INTEGER(INTG), INTENT(IN) :: interfacematrixindex
1660  LOGICAL, INTENT(IN) :: istranspose
1661  INTEGER(INTG), INTENT(OUT) :: timedependencetype
1662  INTEGER(INTG), INTENT(OUT) :: err
1663  TYPE(varying_string), INTENT(OUT) :: error
1664 
1665  !Local variables
1666  TYPE(interface_equations_type), POINTER :: interfaceequations
1667  TYPE(interface_matrices_type), POINTER :: interfacematrices
1668  TYPE(interface_matrix_type), POINTER :: interfacematrix
1669  TYPE(varying_string) :: local_error
1670 
1671  enters("InterfaceMatrix_TimeDependenceTypeGet",err,error,*999)
1672 
1673  IF(ASSOCIATED(interfacecondition)) THEN
1674  interfaceequations=>interfacecondition%INTERFACE_EQUATIONS
1675  IF(ASSOCIATED(interfaceequations)) THEN
1676  interfacematrices=>interfaceequations%INTERFACE_MATRICES
1677  IF(ASSOCIATED(interfacematrices)) THEN
1678  interfacematrix=>interfacematrices%MATRICES(interfacematrixindex)%PTR
1679  IF(ASSOCIATED(interfacematrix)) THEN
1680  IF(.NOT.istranspose) THEN
1681  timedependencetype=interfacematrix%INTERFACE_MATRIX_TIME_DEPENDENCE_TYPE
1682  ELSE
1683  IF(interfacematrix%HAS_TRANSPOSE) THEN
1684  timedependencetype=interfacematrix%INTERFACE_MATRIX_TRANSPOSE_TIME_DEPENDENCE_TYPE
1685  ELSE
1686  local_error="Interface matrices has_transpose flag is .false. but interface matrix type is transpose."
1687  CALL flagerror(local_error,err,error,*999)
1688  ENDIF
1689  ENDIF
1690  !Sanity check
1691  IF(.NOT.(timedependencetype>0.AND.timedependencetype<=number_of_interface_matrix_types)) THEN
1692  local_error="Invalid time dependence type of "//trim(number_to_vstring(timedependencetype,"*",err,error))// &
1693  & ". Must be > 0 and <= "//trim(number_to_vstring(number_of_interface_matrix_types,"*",err,error))// &
1694  & "."
1695  CALL flagerror(local_error,err,error,*999)
1696  ENDIF
1697  ELSE
1698  CALL flagerror("Interface matrix is not associated",err,error,*999)
1699  ENDIF
1700  ELSE
1701  CALL flagerror("Interface matrices not associated.",err,error,*999)
1702  ENDIF
1703  ELSE
1704  CALL flagerror("Interface equations not associated.",err,error,*999)
1705  ENDIF
1706  ELSE
1707  CALL flagerror("Interface condition is not associated.",err,error,*999)
1708  ENDIF
1709 
1710  exits("InterfaceMatrix_TimeDependenceTypeGet")
1711  RETURN
1712 999 errorsexits("InterfaceMatrix_TimeDependenceTypeGet",err,error)
1713  RETURN 1
1714  END SUBROUTINE interfacematrix_timedependencetypeget
1715 
1716  !
1717  !================================================================================================================================
1718  !
1719 
1720 
1721 END MODULE interface_matrices_routines
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
distributed_matrix_vector::distributed_matrix_create_finish
subroutine, public distributed_matrix_create_finish(DISTRIBUTED_MATRIX, ERR, ERROR,)
Finishes the creation of a distributed matrix.
Definition: distributed_matrix_vector.f90:1025
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
matrix_vector::matrix_vector_dp_type
integer(intg), parameter, public matrix_vector_dp_type
Double precision real matrix-vector data type.
Definition: matrix_vector.f90:155
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
distributed_matrix_vector::distributed_vector_create_start
subroutine, public distributed_vector_create_start(DOMAIN_MAPPING, DISTRIBUTED_VECTOR, ERR, ERROR,)
Starts the creation a distributed vector.
Definition: distributed_matrix_vector.f90:6475
distributed_matrix_vector::distributed_vector_create_finish
subroutine, public distributed_vector_create_finish(DISTRIBUTED_VECTOR, ERR, ERROR,)
Finishes the creation a distributed vector.
Definition: distributed_matrix_vector.f90:6424
distributed_matrix_vector::distributed_matrix_data_type_set
subroutine, public distributed_matrix_data_type_set(DISTRIBUTED_MATRIX, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed matrix.
Definition: distributed_matrix_vector.f90:1687
types::interface_matrix_type
Contains information about an interface matrix.
Definition: types.f90:1978
distributed_matrix_vector::distributed_matrix_row_major_storage_type
integer(intg), parameter, public distributed_matrix_row_major_storage_type
Distributed matrix row major storage type.
Definition: distributed_matrix_vector.f90:100
types::field_dof_to_param_map_type
A type to hold the mapping from field dof numbers to field parameters (nodes, elements, etc)
Definition: types.f90:1183
distributed_matrix_vector::distributed_matrix_create_start
subroutine, public distributed_matrix_create_start(ROW_DOMAIN_MAPPING, COLUMN_DOMAIN_MAPPING, DISTRIBUTED_MATRIX, ERR, ERROR,)
Starts the creation of a distributed matrix.
Definition: distributed_matrix_vector.f90:1069
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
distributed_matrix_vector::distributed_matrix_storage_type_set
subroutine, public distributed_matrix_storage_type_set(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Sets/changes the storage type of a distributed matrix.
Definition: distributed_matrix_vector.f90:3193
types::interface_mesh_connectivity_type
Contains information on the coupling between meshes in an interface.
Definition: types.f90:2193
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
equations_matrices_routines::equations_matrices_element_matrix_finalise
subroutine, public equations_matrices_element_matrix_finalise(ELEMENT_MATRIX, ERR, ERROR,)
Finalise an element matrix and deallocate all memory.
Definition: equations_matrices_routines.f90:943
types::interface_condition_type
Contains information for the interface condition data.
Definition: types.f90:2155
types::interface_rhs_type
Contains information of the RHS vector for interface matrices.
Definition: types.f90:2003
equations_matrices_routines::equations_matrices_element_vector_finalise
subroutine, public equations_matrices_element_vector_finalise(ELEMENT_VECTOR, ERR, ERROR,)
Finalise an element vector and deallocate all memory.
Definition: equations_matrices_routines.f90:1164
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
interface_matrices_constants::number_of_interface_matrix_types
integer(intg), parameter number_of_interface_matrix_types
Definition: interface_matrices_constants.f90:57
types::interface_mapping_type
Contains information on an interface mapping. TODO: Generalise to non-Lagrange multipler mappings...
Definition: types.f90:2065
equations_matrices_routines::equations_matrices_element_vector_calculate
subroutine, public equations_matrices_element_vector_calculate(ELEMENT_VECTOR, UPDATE_VECTOR, ELEMENT_NUMBER, ROWS_FIELD_VARIABLE, ERR, ERROR,)
Calculate the positions in the equations rhs of the element rhs vector. Old CMISS name MELGE...
Definition: equations_matrices_routines.f90:1066
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
interface_conditions_constants::interface_condition_gauss_integration
integer(intg), parameter interface_condition_gauss_integration
Gauss points integration type, i.e. Loop over element Gauss points and sum up their contribution...
Definition: interface_conditions_constants.f90:101
equations_matrices_routines::equations_matrices_element_matrix_setup
subroutine, public equations_matrices_element_matrix_setup(elementMatrix, rowsFieldVariable, columnsFieldVariable, rowsNumberOfElements, colsNumberOfElements, err, error,)
Sets up the element matrix for the row and column field variables.
Definition: equations_matrices_routines.f90:998
distributed_matrix_vector::distributed_matrix_column_major_storage_type
integer(intg), parameter, public distributed_matrix_column_major_storage_type
Distributed matrix column major storage type.
Definition: distributed_matrix_vector.f90:99
types::domain_elements_type
Contains the topology information for the elements of a domain.
Definition: types.f90:677
distributed_matrix_vector::distributed_matrix_storage_locations_set
subroutine, public distributed_matrix_storage_locations_set(DISTRIBUTED_MATRIX, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Sets the storage locations (sparsity pattern) in a distributed matrix to that specified by the row an...
Definition: distributed_matrix_vector.f90:2945
kinds::dp
integer, parameter dp
Double precision real kind.
Definition: kinds.f90:68
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
interface_conditions_constants::interface_condition_data_points_integration
integer(intg), parameter interface_condition_data_points_integration
Data points integration type i.e. Loop over data points and sum up their contribution.
Definition: interface_conditions_constants.f90:102
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
distributed_matrix_vector::distributed_matrix_destroy
subroutine, public distributed_matrix_destroy(DISTRIBUTED_MATRIX, ERR, ERROR,)
Destroys a distributed matrix.
Definition: distributed_matrix_vector.f90:1807
iso_varying_string::trim
Definition: iso_varying_string.f90:204
interface_conditions_constants::interface_condition_penalty_method
integer(intg), parameter interface_condition_penalty_method
Penalty interface condition method.
Definition: interface_conditions_constants.f90:59
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
distributed_matrix_vector::distributed_matrix_all_values_set
Definition: distributed_matrix_vector.f90:122
distributed_matrix_vector::distributed_vector_all_values_set
Definition: distributed_matrix_vector.f90:346
distributed_matrix_vector::distributed_vector_output
subroutine, public distributed_vector_output(ID, DISTRIBUTED_VECTOR, ERR, ERROR,)
Outputs a distributed vector to the specified output ID.
Definition: distributed_matrix_vector.f90:7311
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
interface_conditions_constants
This module defines all constants shared across interface condition routines.
Definition: interface_conditions_constants.f90:45
distributed_matrix_vector::distributed_matrix_compressed_column_storage_type
integer(intg), parameter, public distributed_matrix_compressed_column_storage_type
Distributed matrix compressed column storage type.
Definition: distributed_matrix_vector.f90:102
distributed_matrix_vector::distributed_matrix_output
subroutine, public distributed_matrix_output(ID, DISTRIBUTED_MATRIX, ERR, ERROR,)
Outputs a distributed matrix.
Definition: distributed_matrix_vector.f90:2469
distributed_matrix_vector::distributed_vector_data_type_set
subroutine, public distributed_vector_data_type_set(DISTRIBUTED_VECTOR, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed vector.
Definition: distributed_matrix_vector.f90:6542
input_output::write_string_fmt_value
Write a string followed by a value formatted in a particular way to a specified output stream...
Definition: input_output.f90:188
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
interface_matrices_constants
This module defines all constants shared across interface matrices routines.
Definition: interface_matrices_constants.f90:45
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
distributed_matrix_vector::distributed_vector_destroy
subroutine, public distributed_vector_destroy(DISTRIBUTED_VECTOR, ERR, ERROR,)
Destroys a distributed vector.
Definition: distributed_matrix_vector.f90:6608
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
equations_matrices_routines::equationsmatrices_elementvectorinitialise
subroutine, public equationsmatrices_elementvectorinitialise(ELEMENT_VECTOR, ERR, ERROR,)
Initialise the element vector.
Definition: equations_matrices_routines.f90:1189
types::domain_mapping_type
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
types::interfacepointsconnectivitytype
Contains information on the data point coupling/points connectivity between meshes in the an interfac...
Definition: types.f90:2218
types::interface_mapping_rhs_type
Definition: types.f90:2043
types::interface_matrices_type
Contains information on the interface matrices.
Definition: types.f90:2012
types::interface_type
Contains information for the interface data.
Definition: types.f90:2228
distributed_matrix_vector::distributed_matrix_vector_dp_type
integer(intg), parameter, public distributed_matrix_vector_dp_type
Double precision real distributed matrix-vector data type.
Definition: distributed_matrix_vector.f90:90
equations_matrices_routines::equations_matrices_element_matrix_calculate
subroutine, public equations_matrices_element_matrix_calculate(ELEMENT_MATRIX, UPDATE_MATRIX, ROW_ELEMENT_NUMBERS, COLUMN_ELEMENT_NUMBERS, ROWS_FIELD_VARIABLE, COLS_FIELD_VARIABLE, ERR, ERROR,)
Calculate the positions in the equations matrices of the element matrix. Old CMISS name MELGE...
Definition: equations_matrices_routines.f90:686
distributed_matrix_vector::distributed_vector_values_add
Definition: distributed_matrix_vector.f90:454
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
distributed_matrix_vector::distributed_matrix_values_add
Definition: distributed_matrix_vector.f90:252
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
equations_matrices_routines::equations_matrices_element_vector_setup
subroutine, public equations_matrices_element_vector_setup(elementVector, rowsFieldVariable, err, error,)
Sets up the element vector for the row field variables.
Definition: equations_matrices_routines.f90:1213
distributed_matrix_vector::distributed_matrix_row_column_storage_type
integer(intg), parameter, public distributed_matrix_row_column_storage_type
Distributed matrix row-column storage type.
Definition: distributed_matrix_vector.f90:103
distributed_matrix_vector::distributed_matrix_number_non_zeros_set
subroutine, public distributed_matrix_number_non_zeros_set(DISTRIBUTED_MATRIX, NUMBER_NON_ZEROS, ERR, ERROR,)
Sets/changes the number of non zeros for a distributed matrix.
Definition: distributed_matrix_vector.f90:2251
equations_matrices_routines::equationsmatrices_elementmatrixinitialise
subroutine, public equationsmatrices_elementmatrixinitialise(ELEMENT_MATRIX, ERR, ERROR,)
Initialise the element matrix.
Definition: equations_matrices_routines.f90:970
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
types::list_ptr_type
Buffer type to allow arrays of pointers to a list.
Definition: types.f90:108
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
types::interface_equations_type
Contains information about the interface equations for an interface condition.
Definition: types.f90:2110
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45