OpenCMISS-Iron Internal API Documentation
interface_mapping_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE interface_mapping_routines
46 
47  USE base_routines
48  USE field_routines
49  USE input_output
50  USE interface_conditions_constants
51  USE iso_varying_string
52  USE kinds
53  USE strings
54  USE types
55 
56 #include "macros.h"
57 
58  IMPLICIT NONE
59 
60  PRIVATE
61 
62  !Module parameters
63 
64  !Module types
65 
66  !Module variables
67 
68  PUBLIC interface_mapping_create_finish,interface_mapping_create_start
69 
70  PUBLIC interface_mapping_destroy
71 
72  PUBLIC interfacemapping_lagrangevariableset
73 
74  PUBLIC interface_mapping_matrices_coeffs_set
75 
76  PUBLIC interfacemapping_matricescolumnmeshindicesset,interfacemapping_matricesrowmeshindicesset
77 
78  PUBLIC interface_mapping_matrices_number_set
79 
80  PUBLIC interface_mapping_matrices_transpose_set
81 
82  PUBLIC interface_mapping_rhs_coeff_set
83 
84  PUBLIC interface_mapping_rhs_variable_type_set
85 
86 CONTAINS
87 
88  !
89  !================================================================================================================================
90  !
91 
93  SUBROUTINE interface_mapping_calculate(INTERFACE_MAPPING,ERR,ERROR,*)
94 
95  !Argument variables
96  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
97  INTEGER(INTG), INTENT(OUT) :: ERR
98  TYPE(varying_string), INTENT(OUT) :: ERROR
99  !Local Variables
100  INTEGER(INTG) :: column_idx,dof_idx,matrix_idx,mesh_idx,variable_idx,number_of_interface_matrices
101  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
102  TYPE(field_type), POINTER :: LAGRANGE_FIELD
103  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,LAGRANGE_VARIABLE
104  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
105  TYPE(interface_dependent_type), POINTER :: INTERFACE_DEPENDENT
106  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
107  TYPE(interface_lagrange_type), POINTER :: LAGRANGE
108  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
109  TYPE(interface_mapping_rhs_type), POINTER :: RHS_MAPPING
110  TYPE(varying_string) :: LOCAL_ERROR
111 
112  enters("INTERFACE_MAPPING_CALCULATE",err,error,*999)
113 
114  IF(ASSOCIATED(interface_mapping)) THEN
115  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
116  IF(ASSOCIATED(create_values_cache)) THEN
117  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
118  IF(ASSOCIATED(interface_equations)) THEN
119  interface_condition=>interface_equations%INTERFACE_CONDITION
120  SELECT CASE(interface_condition%METHOD)
121  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
122  lagrange=>interface_condition%LAGRANGE
123  IF(ASSOCIATED(lagrange)) THEN
124  interface_dependent=>interface_condition%DEPENDENT
125  IF(ASSOCIATED(interface_dependent)) THEN
126  !Set the Lagrange variable information
127  lagrange_field=>lagrange%LAGRANGE_FIELD
128  NULLIFY(lagrange_variable)
129  CALL field_variable_get(lagrange_field,create_values_cache%LAGRANGE_VARIABLE_TYPE,lagrange_variable, &
130  & err,error,*999)
131  interface_mapping%LAGRANGE_VARIABLE_TYPE=create_values_cache%LAGRANGE_VARIABLE_TYPE
132  interface_mapping%LAGRANGE_VARIABLE=>lagrange_variable
133  !Set the number of columns in the interface matrices
134  interface_mapping%NUMBER_OF_COLUMNS=lagrange_variable%NUMBER_OF_DOFS
135  interface_mapping%TOTAL_NUMBER_OF_COLUMNS=lagrange_variable%TOTAL_NUMBER_OF_DOFS
136  interface_mapping%NUMBER_OF_GLOBAL_COLUMNS=lagrange_variable%NUMBER_OF_GLOBAL_DOFS
137  !Set the column dofs mapping
138  interface_mapping%COLUMN_DOFS_MAPPING=>lagrange_variable%DOMAIN_MAPPING
139  ALLOCATE(interface_mapping%LAGRANGE_DOF_TO_COLUMN_MAP(lagrange_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
140  IF(err/=0) CALL flagerror("Could not allocate Lagrange dof to column map.",err,error,*999)
141  !1-1 mapping for now
142  DO dof_idx=1,lagrange_variable%TOTAL_NUMBER_OF_DOFS
143  column_idx=lagrange_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(dof_idx)
144  interface_mapping%LAGRANGE_DOF_TO_COLUMN_MAP(dof_idx)=column_idx
145  ENDDO
146  !Set the number of interface matrices
147  interface_mapping%NUMBER_OF_INTERFACE_MATRICES=create_values_cache%NUMBER_OF_INTERFACE_MATRICES
148  ALLOCATE(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(interface_mapping%NUMBER_OF_INTERFACE_MATRICES), &
149  & stat=err)
150  IF(err/=0) CALL flagerror("Could not allocate interface matrix rows to variable maps.",err,error,*999)
151  !Loop over the interface matrices and calculate the row mappings
152  !The pointers below have been checked for association above.
153  SELECT CASE(interface_condition%METHOD)
154  CASE(interface_condition_lagrange_multipliers_method)
155  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
156  CASE(interface_condition_penalty_method)
157  !Number of interface matrices whose rows/columns are related to Dependent/Lagrange variables and not Lagrange/Lagrange variables (last interface matrix is Lagrange/Lagrange (Penalty matrix)
158  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES-1
159  ENDSELECT
160  DO matrix_idx=1,number_of_interface_matrices
161  !Initialise and setup the interface matrix
162  CALL interfacemapping_matrixtovarmapinitialise(interface_mapping,matrix_idx,err,error,*999)
163  mesh_idx=create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(matrix_idx)
164  NULLIFY(equations_set)
165  NULLIFY(field_variable)
166  DO variable_idx=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
167  IF(interface_dependent%VARIABLE_MESH_INDICES(variable_idx)==mesh_idx) THEN
168  equations_set=>interface_dependent%EQUATIONS_SETS(variable_idx)%PTR
169  field_variable=>interface_dependent%FIELD_VARIABLES(variable_idx)%PTR
170  EXIT
171  ENDIF
172  ENDDO !variable_idx
173  IF(ASSOCIATED(equations_set)) THEN
174  IF(ASSOCIATED(field_variable)) THEN
175  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%EQUATIONS_SET=>equations_set
176  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_TYPE=field_variable%VARIABLE_TYPE
177  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE=>field_variable
178  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MESH_INDEX=mesh_idx
179  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MATRIX_COEFFICIENT=interface_mapping% &
180  & create_values_cache%MATRIX_COEFFICIENTS(matrix_idx)
181  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%HAS_TRANSPOSE=interface_mapping% &
182  & create_values_cache%HAS_TRANSPOSE(matrix_idx)
183  !Set the number of rows
184  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_ROWS=field_variable%NUMBER_OF_DOFS
185  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%TOTAL_NUMBER_OF_ROWS= &
186  & field_variable%TOTAL_NUMBER_OF_DOFS
187  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_GLOBAL_ROWS= &
188  & field_variable%NUMBER_OF_GLOBAL_DOFS
189  !Set the row mapping
190  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%ROW_DOFS_MAPPING=> &
191  & field_variable%DOMAIN_MAPPING
192  ALLOCATE(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_DOF_TO_ROW_MAP( &
193  & field_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
194  IF(err/=0) CALL flagerror("Could not allocate variable dof to row map.",err,error,*999)
195  !1-1 mapping for now
196  DO dof_idx=1,field_variable%TOTAL_NUMBER_OF_DOFS
197  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_DOF_TO_ROW_MAP(dof_idx)=dof_idx
198  ENDDO !dof_idx
199  ELSE
200  local_error="Dependent variable for mesh index "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
201  & " could not be found."
202  CALL flagerror(local_error,err,error,*999)
203  ENDIF
204  ELSE
205  local_error="Equations set for mesh index "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
206  & " could not be found."
207  CALL flagerror(local_error,err,error,*999)
208  ENDIF
209  ENDDO !matrix_idx
210 
211  !The pointers below have been checked for association above.
212  SELECT CASE(interface_condition%METHOD)
213  CASE(interface_condition_penalty_method)
214  !Sets up the Lagrange-(Penalty) interface matrix mapping and calculate the row mappings
215  matrix_idx = interface_mapping%NUMBER_OF_INTERFACE_MATRICES !last of the interface matrices
216  !Initialise and setup the interface matrix
217  CALL interfacemapping_matrixtovarmapinitialise(interface_mapping,matrix_idx,err,error,*999)
218  mesh_idx=create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(matrix_idx)
219  NULLIFY(lagrange_variable)
220  CALL field_variable_get(lagrange_field,create_values_cache%LAGRANGE_VARIABLE_TYPE,lagrange_variable, &
221  & err,error,*999)
222  NULLIFY(interface_equations)
223  NULLIFY(field_variable)
224  field_variable=>lagrange_variable
225  interface_equations=>interface_condition%INTERFACE_EQUATIONS
226  IF(ASSOCIATED(interface_equations)) THEN
227  IF(ASSOCIATED(field_variable)) THEN
228  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%INTERFACE_EQUATIONS=>interface_equations
229  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_TYPE=field_variable%VARIABLE_TYPE
230  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE=>field_variable
231  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MESH_INDEX=mesh_idx
232  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MATRIX_COEFFICIENT=interface_mapping% &
233  & create_values_cache%MATRIX_COEFFICIENTS(matrix_idx)
234  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%HAS_TRANSPOSE=interface_mapping% &
235  & create_values_cache%HAS_TRANSPOSE(matrix_idx)
236  !Set the number of rows
237  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_ROWS=field_variable%NUMBER_OF_DOFS
238  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%TOTAL_NUMBER_OF_ROWS= &
239  & field_variable%TOTAL_NUMBER_OF_DOFS
240  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_GLOBAL_ROWS= &
241  & field_variable%NUMBER_OF_GLOBAL_DOFS
242  !Set the row mapping
243  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%ROW_DOFS_MAPPING=> &
244  & field_variable%DOMAIN_MAPPING
245  ALLOCATE(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_DOF_TO_ROW_MAP( &
246  & field_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
247  IF(err/=0) CALL flagerror("Could not allocate variable dof to row map.",err,error,*999)
248  !1-1 mapping for now
249  DO dof_idx=1,field_variable%TOTAL_NUMBER_OF_DOFS
250  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_DOF_TO_ROW_MAP(dof_idx)=dof_idx
251  ENDDO !dof_idx
252  ELSE
253  local_error="Lagrange variable for mesh index "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
254  & " could not be found."
255  CALL flagerror(local_error,err,error,*999)
256  ENDIF
257  ELSE
258  local_error="Interface Equations for mesh index "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
259  & " could not be found."
260  CALL flagerror(local_error,err,error,*999)
261  ENDIF
262  ENDSELECT
263 
264  !Calculate RHS mappings
265  IF(create_values_cache%RHS_LAGRANGE_VARIABLE_TYPE/=0) THEN
266  CALL interface_mapping_rhs_mapping_initialise(interface_mapping,err,error,*999)
267  rhs_mapping=>interface_mapping%RHS_MAPPING
268  IF(ASSOCIATED(rhs_mapping)) THEN
269  rhs_mapping%RHS_VARIABLE_TYPE=create_values_cache%RHS_LAGRANGE_VARIABLE_TYPE
270  lagrange_variable=>lagrange_field%VARIABLE_TYPE_MAP(create_values_cache%RHS_LAGRANGE_VARIABLE_TYPE)%PTR
271  rhs_mapping%RHS_VARIABLE=>lagrange_variable
272  rhs_mapping%RHS_VARIABLE_MAPPING=>lagrange_variable%DOMAIN_MAPPING
273  rhs_mapping%RHS_COEFFICIENT=create_values_cache%RHS_COEFFICIENT
274  !Allocate and set up the row mappings
275  ALLOCATE(rhs_mapping%RHS_DOF_TO_INTERFACE_ROW_MAP(lagrange_variable%TOTAL_NUMBER_OF_DOFS),stat=err)
276  IF(err/=0) CALL flagerror("Could not allocate rhs dof to interface row map.",err,error,*999)
277  ALLOCATE(rhs_mapping%INTERFACE_ROW_TO_RHS_DOF_MAP(interface_mapping%TOTAL_NUMBER_OF_COLUMNS),stat=err)
278  IF(err/=0) CALL flagerror("Could not allocate interface row to dof map.",err,error,*999)
279  DO dof_idx=1,lagrange_variable%TOTAL_NUMBER_OF_DOFS
280  !1-1 mapping for now
281  column_idx=dof_idx
282  rhs_mapping%RHS_DOF_TO_INTERFACE_ROW_MAP(dof_idx)=column_idx
283  ENDDO !dof_idx
284  DO column_idx=1,interface_mapping%TOTAL_NUMBER_OF_COLUMNS
285  !1-1 mapping for now
286  dof_idx=column_idx
287  rhs_mapping%INTERFACE_ROW_TO_RHS_DOF_MAP(column_idx)=dof_idx
288  ENDDO !column_idx
289  ELSE
290  CALL flagerror("RHS mapping is not associated.",err,error,*999)
291  ENDIF
292  ENDIF
293  ELSE
294  CALL flagerror("Interface condition dependent is not associated.",err,error,*999)
295  ENDIF
296  ELSE
297  CALL flagerror("Interface condition Lagrange is not associated.",err,error,*999)
298  ENDIF
299  CASE(interface_condition_augmented_lagrange_method)
300  CALL flagerror("Not implemented.",err,error,*999)
301  CASE(interface_condition_point_to_point_method)
302  CALL flagerror("Not implemented.",err,error,*999)
303  CASE DEFAULT
304  local_error="The interface condition method of "// &
305  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
306  CALL flagerror(local_error,err,error,*999)
307  END SELECT
308  ELSE
309  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
310  ENDIF
311  ELSE
312  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
313  ENDIF
314  ELSE
315  CALL flagerror("Interface mapping is not associated.",err,error,*999)
316  ENDIF
317 
318  exits("INTERFACE_MAPPING_CALCULATE")
319  RETURN
320 999 errorsexits("INTERFACE_MAPPING_CALCULATE",err,error)
321  RETURN 1
322 
323  END SUBROUTINE interface_mapping_calculate
324 
325  !
326  !================================================================================================================================
327  !
328 
330  SUBROUTINE interface_mapping_create_finish(INTERFACE_MAPPING,ERR,ERROR,*)
331 
332  !Argument variables
333  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
334  INTEGER(INTG), INTENT(OUT) :: ERR
335  TYPE(varying_string), INTENT(OUT) :: ERROR
336  !Local Variables
337 
338  enters("INTERFACE_MAPPING_CREATE_FINISH",err,error,*999)
339 
340  IF(ASSOCIATED(interface_mapping)) THEN
341  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
342  CALL flagerror("Interface mapping has already been finished.",err,error,*999)
343  ELSE
344  !Calculate the equations mapping and clean up
345  CALL interface_mapping_calculate(interface_mapping,err,error,*999)
346  CALL interfacemapping_createvaluescachefinalise(interface_mapping%CREATE_VALUES_CACHE,err,error,*999)
347  interface_mapping%INTERFACE_MAPPING_FINISHED=.true.
348  ENDIF
349  ELSE
350  CALL flagerror("Interface mapping is not associated.",err,error,*999)
351  ENDIF
352 
353  exits("INTERFACE_MAPPING_CREATE_FINISH")
354  RETURN
355 999 errorsexits("INTERFACE_MAPPING_CREATE_FINISH",err,error)
356  RETURN 1
357 
358  END SUBROUTINE interface_mapping_create_finish
359 
360  !
361  !================================================================================================================================
362  !
363 
365  SUBROUTINE interface_mapping_create_start(INTERFACE_EQUATIONS,INTERFACE_MAPPING,ERR,ERROR,*)
366 
367  !Argument variables
368  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
369  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
370  INTEGER(INTG), INTENT(OUT) :: ERR
371  TYPE(varying_string), INTENT(OUT) :: ERROR
372  !Local Variables
373 
374  enters("INTERFACE_MAPPING_CREATE_START",err,error,*999)
375 
376  IF(ASSOCIATED(interface_equations)) THEN
377  IF(interface_equations%INTERFACE_EQUATIONS_FINISHED) THEN
378  IF(ASSOCIATED(interface_mapping)) THEN
379  CALL flagerror("Interface mapping is already associated.",err,error,*999)
380  ELSE
381  NULLIFY(interface_mapping)
382  CALL interface_mapping_initialise(interface_equations,err,error,*999)
383  interface_mapping=>interface_equations%INTERFACE_MAPPING
384  ENDIF
385  ELSE
386  CALL flagerror("Interface equations have not been finished.",err,error,*999)
387  ENDIF
388  ELSE
389  CALL flagerror("Interface equations is not associated.",err,error,*999)
390  ENDIF
391 
392  exits("INTERFACE_MAPPING_CREATE_START")
393  RETURN
394 999 errorsexits("INTERFACE_MAPPING_CREATE_START",err,error)
395  RETURN 1
396 
397  END SUBROUTINE interface_mapping_create_start
398 
399  !
400  !================================================================================================================================
401  !
402 
404  SUBROUTINE interfacemapping_createvaluescachefinalise(CREATE_VALUES_CACHE,ERR,ERROR,*)
405 
406  !Argument variables
407  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
408  INTEGER(INTG), INTENT(OUT) :: ERR
409  TYPE(varying_string), INTENT(OUT) :: ERROR
410  !Local Variables
411 
412  enters("InterfaceMapping_CreateValuesCacheFinalise",err,error,*999)
413 
414  IF(ASSOCIATED(create_values_cache)) THEN
415  IF(ALLOCATED(create_values_cache%MATRIX_COEFFICIENTS)) DEALLOCATE(create_values_cache%MATRIX_COEFFICIENTS)
416  IF(ALLOCATED(create_values_cache%HAS_TRANSPOSE)) DEALLOCATE(create_values_cache%HAS_TRANSPOSE)
417  IF(ALLOCATED(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES)) &
418  & DEALLOCATE(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES)
419  IF(ALLOCATED(create_values_cache%MATRIX_COL_FIELD_VARIABLE_INDICES)) &
420  & DEALLOCATE(create_values_cache%MATRIX_COL_FIELD_VARIABLE_INDICES)
421  DEALLOCATE(create_values_cache)
422  ENDIF
423 
424  exits("InterfaceMapping_CreateValuesCacheFinalise")
425  RETURN
426 999 errorsexits("InterfaceMapping_CreateValuesCacheFinalise",err,error)
427  RETURN 1
428  END SUBROUTINE interfacemapping_createvaluescachefinalise
429 
430  !
431  !================================================================================================================================
432  !
433 
435  SUBROUTINE interfacemapping_createvaluescacheinitialise(INTERFACE_MAPPING,ERR,ERROR,*)
436 
437  !Argument variables
438  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
439  INTEGER(INTG), INTENT(OUT) :: ERR
440  TYPE(varying_string), INTENT(OUT) :: ERROR
441  !Local Variables
442  INTEGER(INTG) :: DUMMY_ERR,variable_idx,variable_type_idx,variable_type_idx2
443  TYPE(field_type), POINTER :: LAGRANGE_FIELD
444  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
445  TYPE(interface_dependent_type), POINTER :: INTERFACE_DEPENDENT
446  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
447  TYPE(interface_lagrange_type), POINTER :: LAGRANGE
448  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
449 
450  enters("InterfaceMapping_CreateValuesCacheInitialise",err,error,*998)
451 
452  IF(ASSOCIATED(interface_mapping)) THEN
453  IF(ASSOCIATED(interface_mapping%CREATE_VALUES_CACHE)) THEN
454  CALL flagerror("Interface mapping create values cache is already associated.",err,error,*998)
455  ELSE
456  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
457  IF(ASSOCIATED(interface_equations)) THEN
458  interface_condition=>interface_equations%INTERFACE_CONDITION
459  IF(ASSOCIATED(interface_condition)) THEN
460  !Allocate and initialise the create values cache
461  ALLOCATE(interface_mapping%CREATE_VALUES_CACHE,stat=err)
462  IF(err/=0) CALL flagerror("Could not allocate interface mapping create values cache.",err,error,*999)
463  interface_mapping%CREATE_VALUES_CACHE%NUMBER_OF_INTERFACE_MATRICES=0
464  interface_mapping%CREATE_VALUES_CACHE%LAGRANGE_VARIABLE_TYPE=0
465  interface_mapping%CREATE_VALUES_CACHE%RHS_LAGRANGE_VARIABLE_TYPE=0
466  interface_mapping%CREATE_VALUES_CACHE%RHS_COEFFICIENT=0.0_dp
467  !Set the default interface mapping in the create values cache
468  !First calculate how many interface matrices we have and set the variable types
469  SELECT CASE(interface_condition%METHOD)
470  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
471  lagrange=>interface_condition%LAGRANGE
472  IF(ASSOCIATED(lagrange)) THEN
473  lagrange_field=>lagrange%LAGRANGE_FIELD
474  IF(ASSOCIATED(lagrange_field)) THEN
475  interface_dependent=>interface_condition%DEPENDENT
476  IF(ASSOCIATED(interface_dependent)) THEN
477  !The pointers below have been checked for association above.
478  SELECT CASE(interface_condition%METHOD)
479  CASE(interface_condition_lagrange_multipliers_method)
480  !Default the number of interface matrices to the number of added dependent variables
481  interface_mapping%CREATE_VALUES_CACHE%NUMBER_OF_INTERFACE_MATRICES= &
482  interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
483  CASE(interface_condition_penalty_method)
484  !Default the number of interface matrices to the number of added dependent variables plus a single Lagrange variable
485  interface_mapping%CREATE_VALUES_CACHE%NUMBER_OF_INTERFACE_MATRICES= &
486  interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES+1
487  END SELECT
488  !Default the Lagrange variable to the first Lagrange variable
489  interface_mapping%CREATE_VALUES_CACHE%LAGRANGE_VARIABLE_TYPE=0
490  DO variable_type_idx=1,field_number_of_variable_types
491  IF(ASSOCIATED(lagrange_field%VARIABLE_TYPE_MAP(variable_type_idx)%PTR)) THEN
492  interface_mapping%CREATE_VALUES_CACHE%LAGRANGE_VARIABLE_TYPE=variable_type_idx
493  EXIT
494  ENDIF
495  ENDDO !variable_type_idx
496  IF(interface_mapping%CREATE_VALUES_CACHE%LAGRANGE_VARIABLE_TYPE==0) &
497  & CALL flagerror("Could not find a Lagrange variable type in the Lagrange field.",err,error,*999)
498  !Default the RHS Lagrange variable to the second Lagrange variable
499  DO variable_type_idx2=variable_type_idx+1,field_number_of_variable_types
500  IF(ASSOCIATED(lagrange_field%VARIABLE_TYPE_MAP(variable_type_idx2)%PTR)) THEN
501  interface_mapping%CREATE_VALUES_CACHE%RHS_LAGRANGE_VARIABLE_TYPE=variable_type_idx2
502  EXIT
503  ENDIF
504  ENDDO !variable_type_idx2
505  IF(interface_mapping%CREATE_VALUES_CACHE%RHS_LAGRANGE_VARIABLE_TYPE==0) &
506  & CALL flagerror("Could not find a RHS Lagrange variable type in the Lagrange field.",err,error,*999)
507  ALLOCATE(interface_mapping%CREATE_VALUES_CACHE%MATRIX_COEFFICIENTS(interface_mapping% &
508  & create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
509  IF(err/=0) CALL flagerror("Could not allocate create values cache matrix coefficients.",err,error,*999)
510  !Default the interface matrices coefficients to add.
511  interface_mapping%CREATE_VALUES_CACHE%MATRIX_COEFFICIENTS=1.0_dp
512  interface_mapping%CREATE_VALUES_CACHE%RHS_COEFFICIENT=1.0_dp
513  ALLOCATE(interface_mapping%CREATE_VALUES_CACHE%HAS_TRANSPOSE(interface_mapping% &
514  & create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
515  IF(err/=0) CALL flagerror("Could not allocate create values cache has transpose.",err,error,*999)
516  !Default the interface matrices to all have a transpose
517  interface_mapping%CREATE_VALUES_CACHE%HAS_TRANSPOSE=.true.
518  ALLOCATE(interface_mapping%CREATE_VALUES_CACHE%MATRIX_ROW_FIELD_VARIABLE_INDICES(interface_mapping% &
519  & create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
520  IF(err/=0) CALL flagerror("Could not allocate create values cache matrix row field variable indexes.", &
521  & err,error,*999)
522  !Default the interface matrices to be in mesh index order.
523  DO variable_idx=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
524  interface_mapping%CREATE_VALUES_CACHE%MATRIX_ROW_FIELD_VARIABLE_INDICES(variable_idx)=variable_idx
525  ENDDO !variable_idx
526  !The pointers below have been checked for association above.
527  SELECT CASE(interface_condition%METHOD)
528  CASE(interface_condition_penalty_method)
529  !Default the interface matrix (Penalty) to have no transpose
530  interface_mapping%CREATE_VALUES_CACHE%HAS_TRANSPOSE(interface_mapping% &
531  & create_values_cache%NUMBER_OF_INTERFACE_MATRICES)=.false.
532  !Default the interface matrices to be in mesh index order (and set Penalty matrix (last interface matrix)to be the first Lagrange variable).
533  interface_mapping%CREATE_VALUES_CACHE%MATRIX_ROW_FIELD_VARIABLE_INDICES(interface_dependent% &
534  & number_of_dependent_variables+1)=1
535  END SELECT
536  ELSE
537  CALL flagerror("Interface condition depdendent is not associated.",err,error,*999)
538  ENDIF
539  ELSE
540  CALL flagerror("Interface condition Lagrange field is not associated.",err,error,*999)
541  ENDIF
542  ELSE
543  CALL flagerror("Interface condition Lagrange is not associated.",err,error,*999)
544  ENDIF
545  CASE(interface_condition_augmented_lagrange_method)
546  CALL flagerror("Not implemented.",err,error,*999)
547  CASE(interface_condition_point_to_point_method)
548  CALL flagerror("Not implemented.",err,error,*999)
549  CASE DEFAULT
550  local_error="The interface equations method of "// &
551  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))// &
552  & " is invalid."
553  CALL flagerror(local_error,err,error,*999)
554  END SELECT
555  ELSE
556  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
557  ENDIF
558  ELSE
559  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*998)
560  ENDIF
561  ENDIF
562  ELSE
563  CALL flagerror("Interface mapping is not associated.",err,error,*998)
564  ENDIF
565 
566  exits("InterfaceMapping_CreateValuesCacheInitialise")
567  RETURN
568 999 CALL interfacemapping_createvaluescachefinalise(interface_mapping%CREATE_VALUES_CACHE,dummy_err,dummy_error,*998)
569 998 errors("InterfaceMapping_CreateValuesCacheInitialise",err,error)
570  exits("InterfaceMapping_CreateValuesCacheInitialise")
571  RETURN 1
572 
573  END SUBROUTINE interfacemapping_createvaluescacheinitialise
574 
575  !
576  !================================================================================================================================
577  !
578 
580  SUBROUTINE interface_mapping_destroy(INTERFACE_MAPPING,ERR,ERROR,*)
581 
582  !Argument variables
583  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
584  INTEGER(INTG), INTENT(OUT) :: ERR
585  TYPE(varying_string), INTENT(OUT) :: ERROR
586  !Local Variables
587 
588  enters("INTERFACE_MAPPING_DESTROY",err,error,*999)
589 
590  IF(ASSOCIATED(interface_mapping)) THEN
591  CALL interface_mapping_finalise(interface_mapping,err,error,*999)
592  ELSE
593  CALL flagerror("Equations mapping is not associated.",err,error,*999)
594  ENDIF
595 
596  exits("INTERFACE_MAPPING_DESTROY")
597  RETURN
598 999 errorsexits("INTERFACE_MAPPING_DESTROY",err,error)
599  RETURN 1
600 
601  END SUBROUTINE interface_mapping_destroy
602 
603  !
604  !================================================================================================================================
605  !
606 
608  SUBROUTINE interface_mapping_finalise(INTERFACE_MAPPING,ERR,ERROR,*)
609 
610  !Argument variables
611  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
612  INTEGER(INTG), INTENT(OUT) :: ERR
613  TYPE(varying_string), INTENT(OUT) :: ERROR
614  !Local Variables
615  INTEGER(INTG) :: matrix_idx
616 
617  enters("INTERFACE_MAPPING_FINALISE",err,error,*999)
618 
619  IF(ASSOCIATED(interface_mapping)) THEN
620  IF(ALLOCATED(interface_mapping%LAGRANGE_DOF_TO_COLUMN_MAP)) DEALLOCATE(interface_mapping%LAGRANGE_DOF_TO_COLUMN_MAP)
621  IF(ALLOCATED(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS)) THEN
622  DO matrix_idx=1,SIZE(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS,1)
623  CALL interfacemapping_matrixtovarmapfinalise(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx), &
624  & err,error,*999)
625  ENDDO !matrix_idx
626  DEALLOCATE(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS)
627  ENDIF
628  CALL interface_mapping_rhs_mapping_finalise(interface_mapping%RHS_MAPPING,err,error,*999)
629  CALL interfacemapping_createvaluescachefinalise(interface_mapping%CREATE_VALUES_CACHE,err,error,*999)
630  DEALLOCATE(interface_mapping)
631  ENDIF
632 
633  exits("INTERFACE_MAPPING_FINALISE")
634  RETURN
635 999 errorsexits("INTERFACE_MAPPING_FINALISE",err,error)
636  RETURN 1
637 
638  END SUBROUTINE interface_mapping_finalise
639 
640  !
641  !================================================================================================================================
642  !
643 
645  SUBROUTINE interface_mapping_initialise(INTERFACE_EQUATIONS,ERR,ERROR,*)
646 
647  !Argument variables
648  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
649  INTEGER(INTG), INTENT(OUT) :: ERR
650  TYPE(varying_string), INTENT(OUT) :: ERROR
651  !Local Variables
652  INTEGER(INTG) :: DUMMY_ERR
653  TYPE(varying_string) :: DUMMY_ERROR
654 
655  enters("INTERFACE_MAPPING_INITIALISE",err,error,*998)
656 
657  IF(ASSOCIATED(interface_equations)) THEN
658  IF(ASSOCIATED(interface_equations%INTERFACE_MAPPING)) THEN
659  CALL flagerror("Interface mapping is already associated.",err,error,*998)
660  ELSE
661  ALLOCATE(interface_equations%INTERFACE_MAPPING,stat=err)
662  IF(err/=0) CALL flagerror("Could not allocate interface equations interface mapping.",err,error,*999)
663  interface_equations%INTERFACE_MAPPING%INTERFACE_EQUATIONS=>interface_equations
664  interface_equations%INTERFACE_MAPPING%INTERFACE_MAPPING_FINISHED=.false.
665  interface_equations%INTERFACE_MAPPING%LAGRANGE_VARIABLE_TYPE=0
666  NULLIFY(interface_equations%INTERFACE_MAPPING%LAGRANGE_VARIABLE)
667  interface_equations%INTERFACE_MAPPING%NUMBER_OF_COLUMNS=0
668  interface_equations%INTERFACE_MAPPING%TOTAL_NUMBER_OF_COLUMNS=0
669  interface_equations%INTERFACE_MAPPING%NUMBER_OF_GLOBAL_COLUMNS=0
670  NULLIFY(interface_equations%INTERFACE_MAPPING%COLUMN_DOFS_MAPPING)
671  interface_equations%INTERFACE_MAPPING%NUMBER_OF_INTERFACE_MATRICES=0
672  NULLIFY(interface_equations%INTERFACE_MAPPING%RHS_MAPPING)
673  NULLIFY(interface_equations%INTERFACE_MAPPING%CREATE_VALUES_CACHE)
674  CALL interfacemapping_createvaluescacheinitialise(interface_equations%INTERFACE_MAPPING,err,error,*999)
675  ENDIF
676  ELSE
677  CALL flagerror("Interface equations is not associated.",err,error,*998)
678  ENDIF
679 
680  exits("INTERFACE_MAPPING_INITIALISE")
681  RETURN
682 999 CALL interface_mapping_finalise(interface_equations%INTERFACE_MAPPING,dummy_err,dummy_error,*998)
683 998 errorsexits("INTERFACE_MAPPING_INITIALISE",err,error)
684  RETURN 1
685 
686  END SUBROUTINE interface_mapping_initialise
687 
688  !
689  !================================================================================================================================
690  !
691 
693  SUBROUTINE interfacemapping_lagrangevariableset(INTERFACE_MAPPING,LAGRANGE_VARIABLE_TYPE,ERR,ERROR,*)
694 
695  !Argument variables
696  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
697  INTEGER(INTG), INTENT(IN) :: LAGRANGE_VARIABLE_TYPE
698  INTEGER(INTG), INTENT(OUT) :: ERR
699  TYPE(varying_string), INTENT(OUT) :: ERROR
700  !Local Variables
701  TYPE(field_type), POINTER :: LAGRANGE_FIELD
702  TYPE(field_variable_type), POINTER :: LAGRANGE_VARIABLE
703  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
704  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
705  TYPE(interface_lagrange_type), POINTER :: LAGRANGE
706  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
707  TYPE(varying_string) :: LOCAL_ERROR
708 
709  enters("InterfaceMapping_LagrangeVariableSet",err,error,*999)
710 
711  IF(ASSOCIATED(interface_mapping)) THEN
712  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
713  CALL flagerror("Interface mapping has been finished.",err,error,*999)
714  ELSE
715  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
716  IF(ASSOCIATED(create_values_cache)) THEN
717  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
718  IF(ASSOCIATED(interface_equations)) THEN
719  interface_condition=>interface_equations%INTERFACE_CONDITION
720  IF(ASSOCIATED(interface_condition)) THEN
721  SELECT CASE(interface_condition%METHOD)
722  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
723  lagrange=>interface_condition%LAGRANGE
724  IF(ASSOCIATED(lagrange)) THEN
725  IF(lagrange%LAGRANGE_FINISHED) THEN
726  lagrange_field=>lagrange%LAGRANGE_FIELD
727  NULLIFY(lagrange_variable)
728  CALL field_variable_get(lagrange_field,lagrange_variable_type,lagrange_variable,err,error,*999)
729  create_values_cache%LAGRANGE_VARIABLE_TYPE=lagrange_variable_type
730  ELSE
731  CALL flagerror("Interface condition Lagrange field has not been finished.",err,error,*999)
732  ENDIF
733  ELSE
734  CALL flagerror("Interface condition Lagrange is not associated.",err,error,*999)
735  ENDIF
736  CASE(interface_condition_augmented_lagrange_method)
737  CALL flagerror("Not implemented.",err,error,*999)
738  CASE(interface_condition_point_to_point_method)
739  CALL flagerror("Not implemented.",err,error,*999)
740  CASE DEFAULT
741  local_error="The interface condition method of "// &
742  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
743  CALL flagerror(local_error,err,error,*999)
744  END SELECT
745  ELSE
746  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
747  ENDIF
748  ELSE
749  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
750  ENDIF
751  ELSE
752  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
753  ENDIF
754  ENDIF
755  ELSE
756  CALL flagerror("Interface matrices is not associated.",err,error,*999)
757  ENDIF
758 
759  exits("InterfaceMapping_LagrangeVariableSet")
760  RETURN
761 999 errorsexits("InterfaceMapping_LagrangeVariableSet",err,error)
762  RETURN 1
763 
764  END SUBROUTINE interfacemapping_lagrangevariableset
765 
766  !
767  !================================================================================================================================
768  !
769 
771  SUBROUTINE interfacemapping_matrixtovarmapfinalise(INTERFACE_MATRIX_TO_VAR_MAP,ERR,ERROR,*)
772 
773  !Argument variables
774  TYPE(interface_matrix_to_var_map_type) :: INTERFACE_MATRIX_TO_VAR_MAP
775  INTEGER(INTG), INTENT(OUT) :: ERR
776  TYPE(varying_string), INTENT(OUT) :: ERROR
777  !Local Variables
778 
779  enters("InterfaceMapping_MatrixToVarMapFinalise",err,error,*999)
780 
781  IF(ALLOCATED(interface_matrix_to_var_map%VARIABLE_DOF_TO_ROW_MAP)) &
782  & DEALLOCATE(interface_matrix_to_var_map%VARIABLE_DOF_TO_ROW_MAP)
783 
784  exits("InterfaceMapping_MatrixToVarMapFinalise")
785  RETURN
786 999 errorsexits("InterfaceMapping_MatrixToVarMapFinalise",err,error)
787  RETURN 1
788 
789  END SUBROUTINE interfacemapping_matrixtovarmapfinalise
790 
791  !
792  !================================================================================================================================
793  !
794 
796  SUBROUTINE interfacemapping_matrixtovarmapinitialise(INTERFACE_MAPPING,matrix_idx,ERR,ERROR,*)
797 
798  !Argument variables
799  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
800  INTEGER(INTG), INTENT(IN) :: matrix_idx
801  INTEGER(INTG), INTENT(OUT) :: ERR
802  TYPE(varying_string), INTENT(OUT) :: ERROR
803  !Local Variables
804  TYPE(varying_string) :: LOCAL_ERROR
805 
806  enters("InterfaceMapping_MatrixToVarMapInitialise",err,error,*999)
807 
808  IF(ASSOCIATED(interface_mapping)) THEN
809  IF(ALLOCATED(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS)) THEN
810  IF(matrix_idx>0.AND.matrix_idx<=interface_mapping%NUMBER_OF_INTERFACE_MATRICES) THEN
811  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MATRIX_NUMBER=matrix_idx
812  NULLIFY(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%INTERFACE_MATRIX)
813  NULLIFY(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%EQUATIONS_SET)
814  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE_TYPE=0
815  NULLIFY(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%VARIABLE)
816  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MESH_INDEX=0
817  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%MATRIX_COEFFICIENT=0.0_dp
818  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%HAS_TRANSPOSE=.false.
819  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_ROWS=0
820  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%TOTAL_NUMBER_OF_ROWS=0
821  interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%NUMBER_OF_GLOBAL_ROWS=0
822  NULLIFY(interface_mapping%INTERFACE_MATRIX_ROWS_TO_VAR_MAPS(matrix_idx)%ROW_DOFS_MAPPING)
823  ELSE
824  local_error="The specified matrix index of "//trim(number_to_vstring(matrix_idx,"*",err,error))// &
825  & " is invalid. The index must be > 0 and <= "// &
826  & trim(number_to_vstring(interface_mapping%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//"."
827  CALL flagerror(local_error,err,error,*999)
828  ENDIF
829  ELSE
830  CALL flagerror("Interface mapping matrix rows to var maps is not allocated.",err,error,*999)
831  ENDIF
832  ELSE
833  CALL flagerror("Interface mapping is not associated.",err,error,*999)
834  ENDIF
835 
836  exits("InterfaceMapping_MatrixToVarMapInitialise")
837  RETURN
838 999 errorsexits("InterfaceMapping_MatrixToVarMapInitialise",err,error)
839  RETURN 1
840 
841  END SUBROUTINE interfacemapping_matrixtovarmapinitialise
842 
843  !
844  !================================================================================================================================
845  !
846 
848  SUBROUTINE interface_mapping_matrices_coeffs_set(INTERFACE_MAPPING,MATRIX_COEFFICIENTS,ERR,ERROR,*)
849 
850  !Argument variables
851  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
852  REAL(DP), INTENT(IN) :: MATRIX_COEFFICIENTS(:)
853  INTEGER(INTG), INTENT(OUT) :: ERR
854  TYPE(varying_string), INTENT(OUT) :: ERROR
855  !Local Variables
856  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
857  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
858  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
859  TYPE(varying_string) :: LOCAL_ERROR
860 
861  enters("INTERFACE_MAPPING_MATRICES_COEFFS_SET",err,error,*999)
862 
863  IF(ASSOCIATED(interface_mapping)) THEN
864  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
865  CALL flagerror("Interface mapping has been finished.",err,error,*999)
866  ELSE
867  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
868  IF(ASSOCIATED(create_values_cache)) THEN
869  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
870  IF(ASSOCIATED(interface_equations)) THEN
871  interface_condition=>interface_equations%INTERFACE_CONDITION
872  IF(ASSOCIATED(interface_condition)) THEN
873  SELECT CASE(interface_condition%METHOD)
874  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
875  !Check that the number of supplied coefficients matches the number of interface matrices
876  IF(SIZE(matrix_coefficients,1)==create_values_cache%NUMBER_OF_INTERFACE_MATRICES) THEN
877  create_values_cache%MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
878  & matrix_coefficients(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
879  ELSE
880  local_error="Invalid size of matrix coefficeints. The size of the supplied array ("// &
881  & trim(number_to_vstring(SIZE(matrix_coefficients,1),"*",err,error))// &
882  & ") must match the number of interface matrices ("// &
883  & trim(number_to_vstring(create_values_cache%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//")."
884  CALL flagerror(local_error,err,error,*999)
885  ENDIF
886  CASE(interface_condition_augmented_lagrange_method)
887  CALL flagerror("Not implemented.",err,error,*999)
888  CASE(interface_condition_point_to_point_method)
889  CALL flagerror("Not implemented.",err,error,*999)
890  CASE DEFAULT
891  local_error="The interface condition method of "// &
892  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
893  CALL flagerror(local_error,err,error,*999)
894  END SELECT
895  ELSE
896  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
897  ENDIF
898  ELSE
899  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
900  ENDIF
901  ELSE
902  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
903  ENDIF
904  ENDIF
905  ELSE
906  CALL flagerror("Interface matrices is not associated.",err,error,*999)
907  ENDIF
908 
909  exits("INTERFACE_MAPPING_MATRICES_COEFFS_SET")
910  RETURN
911 999 errorsexits("INTERFACE_MAPPING_MATRICES_COEFFS_SET",err,error)
912  RETURN 1
913  END SUBROUTINE interface_mapping_matrices_coeffs_set
914 
915  !
916  !================================================================================================================================
917  !
918 
920  SUBROUTINE interfacemapping_matricescolumnmeshindicesset(INTERFACE_MAPPING,COLUMN_MESH_INDICES,ERR,ERROR,*)
921 
922  !Argument variables
923  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
924  INTEGER(INTG), INTENT(IN) :: COLUMN_MESH_INDICES(:)
925  INTEGER(INTG), INTENT(OUT) :: ERR
926  TYPE(varying_string), INTENT(OUT) :: ERROR
927  !Local Variables
928  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
929  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
930  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
931  TYPE(varying_string) :: LOCAL_ERROR
932 
933  enters("InterfaceMapping_MatricesColumnMeshIndicesSet",err,error,*999)
934 
935  IF(ASSOCIATED(interface_mapping)) THEN
936  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
937  CALL flagerror("Interface mapping has been finished.",err,error,*999)
938  ELSE
939  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
940  IF(ASSOCIATED(create_values_cache)) THEN
941  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
942  IF(ASSOCIATED(interface_equations)) THEN
943  interface_condition=>interface_equations%INTERFACE_CONDITION
944  IF(ASSOCIATED(interface_condition)) THEN
945  SELECT CASE(interface_condition%METHOD)
946  CASE(interface_condition_lagrange_multipliers_method)
947  CALL flagerror("Can not set the column mesh indices when using the Lagrange multipliers "// &
948  "interface condition method.",err,error,*999)
949  CASE(interface_condition_augmented_lagrange_method)
950  CALL flagerror("Not implemented.",err,error,*999)
951  CASE(interface_condition_penalty_method)
952  CALL flagerror("Not implemented.",err,error,*999)
953  CASE(interface_condition_point_to_point_method)
954  CALL flagerror("Not implemented.",err,error,*999)
955  CASE DEFAULT
956  local_error="The interface condition method of "// &
957  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
958  CALL flagerror(local_error,err,error,*999)
959  END SELECT
960  ELSE
961  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
962  ENDIF
963  ELSE
964  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
965  ENDIF
966  ELSE
967  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
968  ENDIF
969  ENDIF
970  ELSE
971  CALL flagerror("Interface matrices is not associated.",err,error,*999)
972  ENDIF
973 
974  exits("InterfaceMapping_MatricesColumnMeshIndicesSet")
975  RETURN
976 999 errors("InterfaceMapping_MatricesColumnMeshIndicesSet",err,error)
977  exits("InterfaceMapping_MatricesColumnMeshIndicesSet")
978  RETURN 1
979 
980  END SUBROUTINE interfacemapping_matricescolumnmeshindicesset
981 
982  !
983  !================================================================================================================================
984  !
985 
987  SUBROUTINE interfacemapping_matricesrowmeshindicesset(INTERFACE_MAPPING,ROW_MESH_INDICES,ERR,ERROR,*)
988 
989  !Argument variables
990  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
991  INTEGER(INTG), INTENT(IN) :: ROW_MESH_INDICES(:)
992  INTEGER(INTG), INTENT(OUT) :: ERR
993  TYPE(varying_string), INTENT(OUT) :: ERROR
994  !Local Variables
995  INTEGER(INTG) :: mesh_idx,mesh_idx2,mesh_idx3
996  LOGICAL :: FOUND
997  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
998  TYPE(interface_dependent_type), POINTER :: INTERFACE_DEPENDENT
999  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
1000  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1001  TYPE(varying_string) :: LOCAL_ERROR
1002 
1003  enters("InterfaceMapping_MatricesRowMeshIndicesSet",err,error,*999)
1004 
1005  IF(ASSOCIATED(interface_mapping)) THEN
1006  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1007  CALL flagerror("Interface mapping has been finished.",err,error,*999)
1008  ELSE
1009  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
1010  IF(ASSOCIATED(create_values_cache)) THEN
1011  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
1012  IF(ASSOCIATED(interface_equations)) THEN
1013  interface_condition=>interface_equations%INTERFACE_CONDITION
1014  IF(ASSOCIATED(interface_condition)) THEN
1015  SELECT CASE(interface_condition%METHOD)
1016  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
1017  !Check the size of the mesh indicies array
1018  IF(SIZE(row_mesh_indices,1)==create_values_cache%NUMBER_OF_INTERFACE_MATRICES) THEN
1019  !Check that mesh indices are valid.
1020  interface_dependent=>interface_condition%DEPENDENT
1021  IF(ASSOCIATED(interface_dependent)) THEN
1022  DO mesh_idx=1,create_values_cache%NUMBER_OF_INTERFACE_MATRICES
1023  found=.false.
1024  DO mesh_idx2=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
1025  IF(row_mesh_indices(mesh_idx)==interface_dependent%VARIABLE_MESH_INDICES(mesh_idx2)) THEN
1026  found=.true.
1027  EXIT
1028  ENDIF
1029  ENDDO !mesh_idx2
1030  IF(found) THEN
1031  !Check that the mesh index has not been repeated.
1032  DO mesh_idx3=mesh_idx+1,create_values_cache%NUMBER_OF_INTERFACE_MATRICES
1033  IF(row_mesh_indices(mesh_idx)==row_mesh_indices(mesh_idx3)) THEN
1034  local_error="The supplied mesh index of "// &
1035  & trim(number_to_vstring(row_mesh_indices(mesh_idx),"*",err,error))// &
1036  & " at position "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
1037  & " has been repeated at position "//trim(number_to_vstring(mesh_idx3,"*",err,error))//"."
1038  CALL flagerror(local_error,err,error,*999)
1039  ENDIF
1040  ENDDO !mesh_idx3
1041  !Set the mesh indices
1042  create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1043  & row_mesh_indices(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1044  ELSE
1045  local_error="The supplied mesh index of "// &
1046  & trim(number_to_vstring(row_mesh_indices(mesh_idx),"*",err,error))// &
1047  & " at position "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
1048  & " has not been added as a dependent variable to the interface condition."
1049  CALL flagerror(local_error,err,error,*999)
1050  ENDIF
1051  ENDDO !mesh_idx
1052  ELSE
1053  CALL flagerror("Interface condition dependent is not assocaited.",err,error,*999)
1054  ENDIF
1055  ELSE
1056  local_error="Invalid size of mesh indices. The size of the supplied array ("// &
1057  & trim(number_to_vstring(SIZE(row_mesh_indices,1),"*",err,error))// &
1058  & ") must match the number of interface matrices ("// &
1059  & trim(number_to_vstring(create_values_cache%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//")."
1060  CALL flagerror(local_error,err,error,*999)
1061  ENDIF
1062  CASE(interface_condition_augmented_lagrange_method)
1063  CALL flagerror("Not implemented.",err,error,*999)
1064  CASE(interface_condition_point_to_point_method)
1065  CALL flagerror("Not implemented.",err,error,*999)
1066  CASE DEFAULT
1067  local_error="The interface condition method of "// &
1068  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
1069  CALL flagerror(local_error,err,error,*999)
1070  END SELECT
1071  ELSE
1072  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
1073  ENDIF
1074  ELSE
1075  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
1076  ENDIF
1077  ELSE
1078  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
1079  ENDIF
1080  ENDIF
1081  ELSE
1082  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1083  ENDIF
1084 
1085  exits("InterfaceMapping_MatricesRowMeshIndicesSet")
1086  RETURN
1087 999 errorsexits("InterfaceMapping_MatricesRowMeshIndicesSet",err,error)
1088  RETURN 1
1089 
1090  END SUBROUTINE interfacemapping_matricesrowmeshindicesset
1091 
1092  !
1093  !================================================================================================================================
1094  !
1095 
1097  SUBROUTINE interface_mapping_matrices_number_set(INTERFACE_MAPPING,NUMBER_OF_INTERFACE_MATRICES,ERR,ERROR,*)
1098 
1099  !Argument variables
1100  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
1101  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_INTERFACE_MATRICES
1102  INTEGER(INTG), INTENT(OUT) :: ERR
1103  TYPE(varying_string), INTENT(OUT) :: ERROR
1104  !Local Variables
1105  INTEGER(INTG) :: matrix_idx,matrix_idx2,variable_idx,number_of_dependent_variables
1106  INTEGER(INTG), ALLOCATABLE :: OLD_MATRIX_ROW_FIELD_VARIABLE_INDICES(:)
1107  LOGICAL :: FOUND
1108  LOGICAL, ALLOCATABLE :: OLD_MATRIX_TRANSPOSE(:)
1109  REAL(DP), ALLOCATABLE :: OLD_MATRIX_COEFFICIENTS(:)
1110  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
1111  TYPE(interface_dependent_type), POINTER :: INTERFACE_DEPENDENT
1112  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
1113  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1114  TYPE(varying_string) :: LOCAL_ERROR
1115 
1116  enters("INTERFACE_MAPPING_MATRICES_NUMBER_SET",err,error,*999)
1117 
1118  IF(ASSOCIATED(interface_mapping)) THEN
1119  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1120  CALL flagerror("Interface mapping has already been finished.",err,error,*999)
1121  ELSE
1122  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
1123  IF(ASSOCIATED(create_values_cache)) THEN
1124  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
1125  IF(ASSOCIATED(interface_equations)) THEN
1126  interface_condition=>interface_equations%INTERFACE_CONDITION
1127  IF(ASSOCIATED(interface_condition)) THEN
1128  SELECT CASE(interface_condition%METHOD)
1129  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
1130  !Check the number of interface matrices
1131  IF(number_of_interface_matrices>0) THEN
1132  interface_dependent=>interface_condition%DEPENDENT
1133  IF(ASSOCIATED(interface_dependent)) THEN
1134  SELECT CASE(interface_condition%METHOD)
1135  CASE(interface_condition_lagrange_multipliers_method)
1136  number_of_dependent_variables=interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
1137  CASE(interface_condition_penalty_method)
1138  number_of_dependent_variables=interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES+1
1139  END SELECT
1140  IF(number_of_interface_matrices<=number_of_dependent_variables) THEN
1141  !If we need to reallocate and reset all the create values cache arrays and change the number of matrices
1142  IF(number_of_interface_matrices/=create_values_cache%NUMBER_OF_INTERFACE_MATRICES) THEN
1143  ALLOCATE(old_matrix_coefficients(create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
1144  IF(err/=0) CALL flagerror("Could not allocate old matrix coefficients.",err,error,*999)
1145  ALLOCATE(old_matrix_transpose(create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
1146  IF(err/=0) CALL flagerror("Could not allocate old matrix transpose.",err,error,*999)
1147  ALLOCATE(old_matrix_row_field_variable_indices(create_values_cache%NUMBER_OF_INTERFACE_MATRICES),stat=err)
1148  IF(err/=0) CALL flagerror("Could not allocate old matrix row field indexes.",err,error,*999)
1149  old_matrix_coefficients(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1150  create_values_cache%MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1151  old_matrix_transpose(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1152  & create_values_cache%HAS_TRANSPOSE(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1153  old_matrix_row_field_variable_indices(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1154  & create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(1:create_values_cache% &
1155  & number_of_interface_matrices)
1156  IF(ALLOCATED(create_values_cache%MATRIX_COEFFICIENTS)) &
1157  & DEALLOCATE(create_values_cache%MATRIX_COEFFICIENTS)
1158  IF(ALLOCATED(create_values_cache%HAS_TRANSPOSE)) &
1159  & DEALLOCATE(create_values_cache%HAS_TRANSPOSE)
1160  IF(ALLOCATED(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES)) &
1161  & DEALLOCATE(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES)
1162  ALLOCATE(create_values_cache%MATRIX_COEFFICIENTS(number_of_interface_matrices),stat=err)
1163  IF(err/=0) CALL flagerror("Could not allocate matrix coefficients.",err,error,*999)
1164  ALLOCATE(create_values_cache%HAS_TRANSPOSE(number_of_interface_matrices),stat=err)
1165  IF(err/=0) CALL flagerror("Could not allocate matrix tranpose.",err,error,*999)
1166  ALLOCATE(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(number_of_interface_matrices),stat=err)
1167  IF(err/=0) CALL flagerror("Could not allocate matrix row field variable indexes.",err,error,*999)
1168  IF(number_of_interface_matrices>create_values_cache%NUMBER_OF_INTERFACE_MATRICES) THEN
1169  create_values_cache%MATRIX_COEFFICIENTS(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1170  & old_matrix_coefficients(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1171  create_values_cache%MATRIX_COEFFICIENTS(create_values_cache%NUMBER_OF_INTERFACE_MATRICES+1: &
1172  & number_of_interface_matrices)=1.0_dp
1173  create_values_cache%HAS_TRANSPOSE(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1174  & old_matrix_transpose(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1175  create_values_cache%HAS_TRANSPOSE(create_values_cache%NUMBER_OF_INTERFACE_MATRICES+1: &
1176  & number_of_interface_matrices)=.true.
1177  create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(1:create_values_cache% &
1178  & number_of_interface_matrices)=old_matrix_row_field_variable_indices(1:create_values_cache% &
1179  & number_of_interface_matrices)
1180  !Loop through in mesh index order and set the default matrix to variable map to be in mesh index order
1181  DO matrix_idx=create_values_cache%NUMBER_OF_INTERFACE_MATRICES+1,number_of_interface_matrices
1182  create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(matrix_idx)=0
1183  DO variable_idx=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
1184  found=.false.
1185  DO matrix_idx2=1,create_values_cache%NUMBER_OF_INTERFACE_MATRICES
1186  IF(interface_dependent%VARIABLE_MESH_INDICES(variable_idx)==create_values_cache% &
1187  matrix_row_field_variable_indices(matrix_idx2)) THEN
1188  found=.true.
1189  EXIT
1190  ENDIF
1191  ENDDO !matrix_idx2
1192  IF(.NOT.found) THEN
1193  create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(matrix_idx)=interface_dependent% &
1194  & variable_mesh_indices(variable_idx)
1195  ENDIF
1196  ENDDO !variable_idx2
1197  IF(create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(matrix_idx)==0) THEN
1198  local_error="Could not map an interface mesh index for interface matrix "// &
1199  & trim(number_to_vstring(matrix_idx,"*",err,error))//"."
1200  CALL flagerror(local_error,err,error,*999)
1201  ENDIF
1202  ENDDO !matrix_idx
1203  ELSE
1204  create_values_cache%MATRIX_COEFFICIENTS(1:number_of_interface_matrices)= &
1205  & old_matrix_coefficients(1:number_of_interface_matrices)
1206  create_values_cache%HAS_TRANSPOSE(1:number_of_interface_matrices)= &
1207  & old_matrix_transpose(1:number_of_interface_matrices)
1208  create_values_cache%MATRIX_ROW_FIELD_VARIABLE_INDICES(1:number_of_interface_matrices)= &
1209  & old_matrix_row_field_variable_indices(1:number_of_interface_matrices)
1210  ENDIF
1211  IF(ALLOCATED(old_matrix_coefficients)) DEALLOCATE(old_matrix_coefficients)
1212  IF(ALLOCATED(old_matrix_transpose)) DEALLOCATE(old_matrix_transpose)
1213  IF(ALLOCATED(old_matrix_row_field_variable_indices)) DEALLOCATE(old_matrix_row_field_variable_indices)
1214  ENDIF
1215  ELSE
1216  local_error="The specified number of interface matrices of "// &
1217  & trim(number_to_vstring(number_of_interface_matrices,"*",err,error))// &
1218  & " is invalid. The number must be <= the number of added dependent variables of "// &
1219  & trim(number_to_vstring(number_of_dependent_variables,"*",err,error))//"."
1220  CALL flagerror(local_error,err,error,*999)
1221  ENDIF
1222  ELSE
1223  CALL flagerror("Interface condition dependent is not associated.",err,error,*999)
1224  ENDIF
1225  ELSE
1226  local_error="The specified number of interface matrices of "// &
1227  & trim(number_to_vstring(number_of_interface_matrices,"*",err,error))// &
1228  & " is invalid. The number must be > 0."
1229  CALL flagerror(local_error,err,error,*999)
1230  ENDIF
1231  CASE(interface_condition_augmented_lagrange_method)
1232  CALL flagerror("Not implemented.",err,error,*999)
1233  CASE(interface_condition_point_to_point_method)
1234  CALL flagerror("Not implemented.",err,error,*999)
1235  CASE DEFAULT
1236  local_error="The interface condition method of "// &
1237  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
1238  CALL flagerror(local_error,err,error,*999)
1239  END SELECT
1240  ELSE
1241  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
1242  ENDIF
1243  ELSE
1244  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
1245  ENDIF
1246  ELSE
1247  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
1248  ENDIF
1249  ENDIF
1250  ELSE
1251  CALL flagerror("Interface mapping is not associated.",err,error,*999)
1252  ENDIF
1253 
1254  exits("INTERFACE_MAPPING_MATRICES_NUMBER_SET")
1255  RETURN
1256 999 IF(ALLOCATED(old_matrix_coefficients)) DEALLOCATE(old_matrix_coefficients)
1257  IF(ALLOCATED(old_matrix_transpose)) DEALLOCATE(old_matrix_transpose)
1258  IF(ALLOCATED(old_matrix_row_field_variable_indices)) DEALLOCATE(old_matrix_row_field_variable_indices)
1259  errorsexits("INTERFACE_MAPPING_MATRICES_NUMBER_SET",err,error)
1260  RETURN 1
1261 
1262  END SUBROUTINE interface_mapping_matrices_number_set
1263 
1264  !
1265  !================================================================================================================================
1266  !
1267 
1269  SUBROUTINE interface_mapping_matrices_transpose_set(INTERFACE_MAPPING,MATRIX_TRANSPOSE,ERR,ERROR,*)
1270 
1271  !Argument variables
1272  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
1273  LOGICAL, INTENT(IN) :: MATRIX_TRANSPOSE(:)
1274  INTEGER(INTG), INTENT(OUT) :: ERR
1275  TYPE(varying_string), INTENT(OUT) :: ERROR
1276  !Local Variables
1277  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
1278  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
1279  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1280  TYPE(varying_string) :: LOCAL_ERROR
1281 
1282  enters("INTERFACE_MAPPING_MATRICES_TRANSPOSE_SET",err,error,*999)
1283 
1284  IF(ASSOCIATED(interface_mapping)) THEN
1285  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1286  CALL flagerror("Interface mapping has been finished.",err,error,*999)
1287  ELSE
1288  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
1289  IF(ASSOCIATED(create_values_cache)) THEN
1290  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
1291  IF(ASSOCIATED(interface_equations)) THEN
1292  interface_condition=>interface_equations%INTERFACE_CONDITION
1293  IF(ASSOCIATED(interface_condition)) THEN
1294  SELECT CASE(interface_condition%METHOD)
1295  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
1296  !Check that the number of supplied coefficients matches the number of interface matrices
1297  IF(SIZE(matrix_transpose,1)==create_values_cache%NUMBER_OF_INTERFACE_MATRICES) THEN
1298  create_values_cache%HAS_TRANSPOSE(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)= &
1299  matrix_transpose(1:create_values_cache%NUMBER_OF_INTERFACE_MATRICES)
1300  ELSE
1301  local_error="Invalid size of matrix tranpose. The size of the supplied array ("// &
1302  & trim(number_to_vstring(SIZE(matrix_transpose,1),"*",err,error))// &
1303  & ") must match the number of interface matrices ("// &
1304  & trim(number_to_vstring(create_values_cache%NUMBER_OF_INTERFACE_MATRICES,"*",err,error))//")."
1305  CALL flagerror(local_error,err,error,*999)
1306  ENDIF
1307  CASE(interface_condition_augmented_lagrange_method)
1308  CALL flagerror("Not implemented.",err,error,*999)
1309  CASE(interface_condition_point_to_point_method)
1310  CALL flagerror("Not implemented.",err,error,*999)
1311  CASE DEFAULT
1312  local_error="The interface condition method of "// &
1313  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
1314  CALL flagerror(local_error,err,error,*999)
1315  END SELECT
1316  ELSE
1317  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
1318  ENDIF
1319  ELSE
1320  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
1321  ENDIF
1322  ELSE
1323  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
1324  ENDIF
1325  ENDIF
1326  ELSE
1327  CALL flagerror("Interface matrices is not associated.",err,error,*999)
1328  ENDIF
1329 
1330  exits("INTERFACE_MAPPING_MATRICES_TRANSPOSE_SET")
1331  RETURN
1332 999 errorsexits("INTERFACE_MAPPING_MATRICES_TRANSPOSE_SET",err,error)
1333  RETURN 1
1334  END SUBROUTINE interface_mapping_matrices_transpose_set
1335 
1336  !
1337  !================================================================================================================================
1338  !
1339 
1341  SUBROUTINE interface_mapping_rhs_coeff_set(INTERFACE_MAPPING,RHS_COEFFICIENT,ERR,ERROR,*)
1342 
1343  !Argument variables
1344  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
1345  REAL(DP), INTENT(IN) :: RHS_COEFFICIENT
1346  INTEGER(INTG), INTENT(OUT) :: ERR
1347  TYPE(varying_string), INTENT(OUT) :: ERROR
1348  !Local Variables
1349 
1350  enters("INTERFACE_MAPPING_RHS_COEFF_SET",err,error,*999)
1351 
1352  IF(ASSOCIATED(interface_mapping)) THEN
1353  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1354  CALL flagerror("Interface mapping has been finished.",err,error,*999)
1355  ELSE
1356  IF(ASSOCIATED(interface_mapping%CREATE_VALUES_CACHE)) THEN
1357  IF(interface_mapping%CREATE_VALUES_CACHE%RHS_LAGRANGE_VARIABLE_TYPE/=0) THEN
1358  interface_mapping%CREATE_VALUES_CACHE%RHS_COEFFICIENT=rhs_coefficient
1359  ELSE
1360  CALL flagerror("The interface mapping RHS Lagrange variable type has not been set.",err,error,*999)
1361  ENDIF
1362  ELSE
1363  CALL flagerror("Interface mapping create values cache is not associated",err,error,*999)
1364  ENDIF
1365  ENDIF
1366  ELSE
1367  CALL flagerror("Interface mapping is not associated",err,error,*999)
1368  ENDIF
1369 
1370  exits("INTERFACE_MAPPING_RHS_COEFF_SET")
1371  RETURN
1372 999 errorsexits("INTERFACE_MAPPING_RHS_COEFF_SET",err,error)
1373  RETURN 1
1374  END SUBROUTINE interface_mapping_rhs_coeff_set
1375 
1376  !
1377  !================================================================================================================================
1378  !
1379 
1381  SUBROUTINE interface_mapping_rhs_mapping_finalise(RHS_MAPPING,ERR,ERROR,*)
1382 
1383  !Argument variables
1384  TYPE(interface_mapping_rhs_type), POINTER :: RHS_MAPPING
1385  INTEGER(INTG), INTENT(OUT) :: ERR
1386  TYPE(varying_string), INTENT(OUT) :: ERROR
1387  !Local Variables
1388 
1389  enters("INTERFACE_MAPPING_RHS_MAPPING_FINALISE",err,error,*999)
1390 
1391  IF(ASSOCIATED(rhs_mapping)) THEN
1392  IF(ALLOCATED(rhs_mapping%RHS_DOF_TO_INTERFACE_ROW_MAP)) DEALLOCATE(rhs_mapping%RHS_DOF_TO_INTERFACE_ROW_MAP)
1393  IF(ALLOCATED(rhs_mapping%INTERFACE_ROW_TO_RHS_DOF_MAP)) DEALLOCATE(rhs_mapping%INTERFACE_ROW_TO_RHS_DOF_MAP)
1394  DEALLOCATE(rhs_mapping)
1395  ENDIF
1396 
1397  exits("INTERFACE_MAPPING_RHS_MAPPING_FINALISE")
1398  RETURN
1399 999 errorsexits("INTERFACE_MAPPING_RHS_MAPPING_FINALISE",err,error)
1400  RETURN 1
1401  END SUBROUTINE interface_mapping_rhs_mapping_finalise
1402 
1403  !
1404  !================================================================================================================================
1405  !
1406 
1408  SUBROUTINE interface_mapping_rhs_mapping_initialise(INTERFACE_MAPPING,ERR,ERROR,*)
1409 
1410  !Argument variables
1411  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
1412  INTEGER(INTG), INTENT(OUT) :: ERR
1413  TYPE(varying_string), INTENT(OUT) :: ERROR
1414  !Local Variables
1415  INTEGER(INTG) :: DUMMY_ERR
1416  TYPE(varying_string) :: DUMMY_ERROR
1417 
1418  enters("INTERFACE_MAPPING_RHS_MAPPING_INITIALISE",err,error,*998)
1419 
1420  IF(ASSOCIATED(interface_mapping)) THEN
1421  IF(ASSOCIATED(interface_mapping%RHS_MAPPING)) THEN
1422  CALL flagerror("Interface mapping RHS mapping is already associated.",err,error,*998)
1423  ELSE
1424  ALLOCATE(interface_mapping%RHS_MAPPING,stat=err)
1425  IF(err/=0) CALL flagerror("Could not allocate interface mapping RHS mapping.",err,error,*999)
1426  interface_mapping%RHS_MAPPING%INTERFACE_MAPPING=>interface_mapping
1427  interface_mapping%RHS_MAPPING%RHS_VARIABLE_TYPE=0
1428  NULLIFY(interface_mapping%RHS_MAPPING%RHS_VARIABLE)
1429  NULLIFY(interface_mapping%RHS_MAPPING%RHS_VARIABLE_MAPPING)
1430  interface_mapping%RHS_MAPPING%RHS_COEFFICIENT=1.0_dp
1431  ENDIF
1432  ELSE
1433  CALL flagerror("Interface mapping is not associated.",err,error,*998)
1434  ENDIF
1435 
1436  exits("INTERFACE_MAPPING_RHS_MAPPING_INITIALISE")
1437  RETURN
1438 999 CALL interface_mapping_rhs_mapping_finalise(interface_mapping%RHS_MAPPING,dummy_err,dummy_error,*998)
1439 998 errorsexits("INTERFACE_MAPPING_RHS_MAPPING_INITIALISE",err,error)
1440  RETURN 1
1441  END SUBROUTINE interface_mapping_rhs_mapping_initialise
1442 
1443  !
1444  !================================================================================================================================
1445  !
1446 
1448  SUBROUTINE interface_mapping_rhs_variable_type_set(INTERFACE_MAPPING,RHS_VARIABLE_TYPE,ERR,ERROR,*)
1449 
1450  !Argument variables
1451  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
1452  INTEGER(INTG), INTENT(IN) :: RHS_VARIABLE_TYPE
1453  INTEGER(INTG), INTENT(OUT) :: ERR
1454  TYPE(varying_string), INTENT(OUT) :: ERROR
1455  !Local Variables
1456  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
1457  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
1458  TYPE(interface_lagrange_type), POINTER :: INTERFACE_LAGRANGE
1459  TYPE(interface_mapping_create_values_cache_type), POINTER :: CREATE_VALUES_CACHE
1460  TYPE(field_type), POINTER :: LAGRANGE_FIELD
1461  TYPE(varying_string) :: LOCAL_ERROR
1462 
1463  enters("INTERFACE_MAPPING_RHS_VARIABLE_TYPE_SET",err,error,*999)
1464 
1465  IF(ASSOCIATED(interface_mapping)) THEN
1466  IF(interface_mapping%INTERFACE_MAPPING_FINISHED) THEN
1467  CALL flagerror("Interface mapping has been finished.",err,error,*999)
1468  ELSE
1469  create_values_cache=>interface_mapping%CREATE_VALUES_CACHE
1470  IF(ASSOCIATED(create_values_cache)) THEN
1471  IF(rhs_variable_type==0) THEN
1472  create_values_cache%RHS_LAGRANGE_VARIABLE_TYPE=0
1473  ELSE
1474  interface_equations=>interface_mapping%INTERFACE_EQUATIONS
1475  IF(ASSOCIATED(interface_equations)) THEN
1476  interface_condition=>interface_equations%INTERFACE_CONDITION
1477  IF(ASSOCIATED(interface_condition)) THEN
1478  SELECT CASE(interface_condition%METHOD)
1479  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
1480  interface_lagrange=>interface_condition%LAGRANGE
1481  IF(ASSOCIATED(interface_lagrange)) THEN
1482  lagrange_field=>interface_lagrange%LAGRANGE_FIELD
1483  IF(ASSOCIATED(lagrange_field)) THEN
1484  !Check the RHS variable type is not being by the interface matrices
1485  IF(create_values_cache%LAGRANGE_VARIABLE_TYPE==rhs_variable_type) THEN
1486  local_error="The specified RHS variable type of "// &
1487  & trim(number_to_vstring(rhs_variable_type,"*",err,error))// &
1488  & " is the same as the Lagrange variable type for the interface matrices."
1489  CALL flagerror(local_error,err,error,*999)
1490  ENDIF
1491  !Check the RHS variable number is defined on the Lagrange field
1492  IF(rhs_variable_type>=1.AND.rhs_variable_type<=field_number_of_variable_types) THEN
1493  IF(ASSOCIATED(lagrange_field%VARIABLE_TYPE_MAP(rhs_variable_type)%PTR)) THEN
1494  create_values_cache%RHS_LAGRANGE_VARIABLE_TYPE=rhs_variable_type
1495  ELSE
1496  local_error="The specified RHS variable type of "// &
1497  & trim(number_to_vstring(rhs_variable_type,"*",err,error))// &
1498  & " is not defined on the Lagrange field."
1499  CALL flagerror(local_error,err,error,*999)
1500  ENDIF
1501  ELSE
1502  local_error="The specified RHS variable type of "// &
1503  & trim(number_to_vstring(rhs_variable_type,"*",err,error))// &
1504  & " is invalid. The number must either be zero or >= 1 and <= "// &
1505  & trim(number_to_vstring(field_number_of_variable_types,"*",err,error))//"."
1506  CALL flagerror(local_error,err,error,*999)
1507  ENDIF
1508  ELSE
1509  CALL flagerror("Lagrange field is not associated.",err,error,*999)
1510  ENDIF
1511  ELSE
1512  CALL flagerror("Interface Lagrange is not associated.",err,error,*999)
1513  ENDIF
1514  CASE(interface_condition_augmented_lagrange_method)
1515  CALL flagerror("Not implemented.",err,error,*999)
1516  CASE(interface_condition_point_to_point_method)
1517  CALL flagerror("Not implemented.",err,error,*999)
1518  CASE DEFAULT
1519  local_error="The interface condition method of "// &
1520  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))//" is invalid."
1521  CALL flagerror(local_error,err,error,*999)
1522  END SELECT
1523  ELSE
1524  CALL flagerror("Interface equations interface condition is not associated.",err,error,*999)
1525  ENDIF
1526  ELSE
1527  CALL flagerror("Interface mapping interface equations is not associated.",err,error,*999)
1528  ENDIF
1529  ENDIF
1530  ELSE
1531  CALL flagerror("Interface mapping create values cache is not associated.",err,error,*999)
1532  ENDIF
1533  ENDIF
1534  ELSE
1535  CALL flagerror("Interface mapping is not associated.",err,error,*999)
1536  ENDIF
1537 
1538  exits("INTERFACE_MAPPING_RHS_VARIABLE_TYPE_SET")
1539  RETURN
1540 999 errorsexits("INTERFACE_MAPPING_RHS_VARIABLE_TYPE_SET",err,error)
1541  RETURN 1
1542  END SUBROUTINE interface_mapping_rhs_variable_type_set
1543 
1544  !
1545  !================================================================================================================================
1546  !
1547 
1548 END MODULE interface_mapping_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
maths::matrix_transpose
Returns the transpose of a matrix A in A^T.
Definition: maths.f90:191
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
interface_conditions_constants::interface_condition_lagrange_multipliers_method
integer(intg), parameter interface_condition_lagrange_multipliers_method
Lagrange multipliers interface condition method.
Definition: interface_conditions_constants.f90:57
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
types::interface_condition_type
Contains information for the interface condition data.
Definition: types.f90:2155
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
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
types::interface_mapping_type
Contains information on an interface mapping. TODO: Generalise to non-Lagrange multipler mappings...
Definition: types.f90:2065
interface_conditions_constants::interface_condition_augmented_lagrange_method
integer(intg), parameter interface_condition_augmented_lagrange_method
Augmented Lagrange multiplers interface condition method.
Definition: interface_conditions_constants.f90:58
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
interface_mapping_routines
This module contains all interface mapping routines.
Definition: interface_mapping_routines.f90:45
types::interface_dependent_type
Contains information about the dependent field information for an interface condition.
Definition: types.f90:2146
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
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
types::interface_lagrange_type
Contains information about the Lagrange field information for an interface condition.
Definition: types.f90:2137
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
types::interface_mapping_create_values_cache_type
Definition: types.f90:2053
interface_conditions_constants
This module defines all constants shared across interface condition routines.
Definition: interface_conditions_constants.f90:45
interface_conditions_constants::interface_condition_point_to_point_method
integer(intg), parameter interface_condition_point_to_point_method
Point to point interface condition method.
Definition: interface_conditions_constants.f90:60
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
types::interface_mapping_rhs_type
Definition: types.f90:2043
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
types::interface_matrix_to_var_map_type
Contains information on interface variable mapping for an interface matrix.
Definition: types.f90:2026
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
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
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45