OpenCMISS-Iron Internal API Documentation
solver_matrices_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
51  USE kinds
52  USE matrix_vector
54  USE strings
55  USE types
56 
57 #include "macros.h"
58 
59  IMPLICIT NONE
60 
61  PRIVATE
62 
63  !Module parameters
64 
65 
70  INTEGER(INTG), PARAMETER :: solver_matrices_all=1
71 ! redundant when introducing dynamic nonlinear equations
72 ! INTEGER(INTG), PARAMETER :: SOLVER_MATRICES_DYNAMIC_ONLY=2 !<Select only the dynamic solver matrices and vectors \see SOLVER_MATRICES_ROUTINES_SelectMatricesTypes,SOLVER_MATRICES_ROUTINES
73  INTEGER(INTG), PARAMETER :: solver_matrices_linear_only=3
74  INTEGER(INTG), PARAMETER :: solver_matrices_nonlinear_only=4
75  INTEGER(INTG), PARAMETER :: solver_matrices_jacobian_only=5
76  INTEGER(INTG), PARAMETER :: solver_matrices_residual_only=6
77  INTEGER(INTG), PARAMETER :: solver_matrices_rhs_only=7
78  INTEGER(INTG), PARAMETER :: solver_matrices_rhs_residual_only=8
80 
81  !Module types
82 
83  !Module variables
84 
85  !Interfaces
86 
89  & solver_matrices_rhs_residual_only !,SOLVER_MATRICES_DYNAMIC_ONLY
90 
92 
95 
96 CONTAINS
97 
98  !
99  !================================================================================================================================
100  !
101 
103  SUBROUTINE solver_matrices_create_finish(SOLVER_MATRICES,ERR,ERROR,*)
105  !Argument variables
106  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
107  INTEGER(INTG), INTENT(OUT) :: ERR
108  TYPE(varying_string), INTENT(OUT) :: ERROR
109  !Local Variables
110  INTEGER(INTG) :: DUMMY_ERR,matrix_idx,NUMBER_OF_NON_ZEROS
111  INTEGER(INTG), POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
112  TYPE(domain_mapping_type), POINTER :: ROW_DOMAIN_MAP,COLUMN_DOMAIN_MAP
113  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
114  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
115  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
116  TYPE(varying_string) :: DUMMY_ERROR
117 
118  NULLIFY(column_indices)
119  NULLIFY(row_indices)
120 
121  enters("SOLVER_MATRICES_CREATE_FINISH",err,error,*998)
122 
123  IF(ASSOCIATED(solver_matrices)) THEN
124  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
125  CALL flagerror("Solver matrices have already been finished",err,error,*998)
126  ELSE
127  solver_equations=>solver_matrices%SOLVER_EQUATIONS
128  IF(ASSOCIATED(solver_equations)) THEN
129  solver_mapping=>solver_equations%SOLVER_MAPPING
130  IF(ASSOCIATED(solver_mapping)) THEN
131  !Now create the individual solver matrices
132  row_domain_map=>solver_mapping%ROW_DOFS_MAPPING
133  IF(ASSOCIATED(row_domain_map)) THEN
134  DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
135  solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
136  IF(ASSOCIATED(solver_matrix)) THEN
137  column_domain_map=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_idx)%COLUMN_DOFS_MAPPING
138  IF(ASSOCIATED(column_domain_map)) THEN
139  !!Create the distributed solver matrix
140  CALL distributed_matrix_create_start(row_domain_map,column_domain_map,solver_matrices%MATRICES(matrix_idx)% &
141  & ptr%MATRIX,err,error,*999)
142  CALL distributed_matrix_library_type_set(solver_matrix%MATRIX,solver_matrices%LIBRARY_TYPE,err,error,*999)
143  CALL distributed_matrix_data_type_set(solver_matrix%MATRIX,matrix_vector_dp_type,err,error,*999)
144  CALL distributed_matrix_storage_type_set(solver_matrix%MATRIX,solver_matrix%STORAGE_TYPE,err,error,*999)
145  !Calculate and set the matrix structure/sparsity pattern
146  IF(solver_matrix%STORAGE_TYPE/=distributed_matrix_block_storage_type.AND. &
147  & solver_matrix%STORAGE_TYPE/=distributed_matrix_diagonal_storage_type) THEN
148  CALL solver_matrix_structure_calculate(solver_matrix,number_of_non_zeros,row_indices, &
149  & column_indices,err,error,*999)
150  CALL distributed_matrix_number_non_zeros_set(solver_matrix%MATRIX,number_of_non_zeros, &
151  & err,error,*999)
152  CALL distributed_matrix_storage_locations_set(solver_matrix%MATRIX,row_indices,column_indices, &
153  & err,error,*999)
154  IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
155  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
156  ENDIF
157  CALL distributed_matrix_create_finish(solver_matrix%MATRIX,err,error,*999)
158  !Allocate the distributed solver vector
159  CALL distributed_vector_create_start(column_domain_map,solver_matrices%MATRICES(matrix_idx)% &
160  & ptr%SOLVER_VECTOR,err,error,*999)
161  CALL distributed_vector_library_type_set(solver_matrix%SOLVER_VECTOR,solver_matrices%LIBRARY_TYPE, &
162  & err,error,*999)
163  CALL distributed_vector_data_type_set(solver_matrix%SOLVER_VECTOR,matrix_vector_dp_type,err,error,*999)
164  CALL distributed_vector_create_finish(solver_matrix%SOLVER_VECTOR,err,error,*999)
165  ELSE
166  CALL flagerror("Column domain mapping is not associated.",err,error,*999)
167  ENDIF
168  ELSE
169  CALL flagerror("Solver matrix is not associated.",err,error,*999)
170  ENDIF
171  ENDDO !matrix_idx
172  IF(solver_equations%LINEARITY==problem_solver_nonlinear) THEN
173  !Allocate the nonlinear matrices and vectors
174  !Allocate the distributed residual vector
175  CALL distributed_vector_create_start(row_domain_map,solver_matrices%RESIDUAL,err,error,*999)
176  CALL distributed_vector_library_type_set(solver_matrices%RESIDUAL,solver_matrices%LIBRARY_TYPE,err,error,*999)
177  CALL distributed_vector_data_type_set(solver_matrices%RESIDUAL,matrix_vector_dp_type,err,error,*999)
178  CALL distributed_vector_create_finish(solver_matrices%RESIDUAL,err,error,*999)
179  ENDIF
180 !!TODO: what to do if there is no RHS
181  !Allocate the distributed rhs vector
182  CALL distributed_vector_create_start(row_domain_map,solver_matrices%RHS_VECTOR,err,error,*999)
183  CALL distributed_vector_library_type_set(solver_matrices%RHS_VECTOR,solver_matrices%LIBRARY_TYPE,err,error,*999)
184  CALL distributed_vector_data_type_set(solver_matrices%RHS_VECTOR,matrix_vector_dp_type,err,error,*999)
185  CALL distributed_vector_create_finish(solver_matrices%RHS_VECTOR,err,error,*999)
186  !Finish up
187  solver_matrices%SOLVER_MATRICES_FINISHED=.true.
188  ELSE
189  CALL flagerror("Row domain mapping is not associated.",err,error,*998)
190  ENDIF
191  ELSE
192  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*998)
193  ENDIF
194  ELSE
195  CALL flagerror("Solver matrices solver equations is not associated.",err,error,*998)
196  ENDIF
197  ENDIF
198  ELSE
199  CALL flagerror("Solver matrices is not associated.",err,error,*998)
200  ENDIF
201 
202  exits("SOLVER_MATRICES_CREATE_FINISH")
203  RETURN
204 999 IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
205  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
206  CALL solver_matrices_finalise(solver_matrices,dummy_err,dummy_error,*998)
207 998 errorsexits("SOLVER_MATRICES_CREATE_FINISH",err,error)
208  RETURN 1
209 
210  END SUBROUTINE solver_matrices_create_finish
211 
212  !
213  !================================================================================================================================
214  !
215 
217  SUBROUTINE solver_matrices_create_start(SOLVER_EQUATIONS,SOLVER_MATRICES,ERR,ERROR,*)
219  !Argument variables
220  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
221  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
222  INTEGER(INTG), INTENT(OUT) :: ERR
223  TYPE(varying_string), INTENT(OUT) :: ERROR
224  !Local Variables
225  INTEGER(INTG) :: DUMMY_ERR
226  TYPE(varying_string) :: DUMMY_ERROR
227 
228  enters("SOLVER_MATRICES_CREATE_START",err,error,*998)
229 
230  IF(ASSOCIATED(solver_equations)) THEN
231  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
232  IF(ASSOCIATED(solver_matrices)) THEN
233  CALL flagerror("Solver matrices is already associated",err,error,*998)
234  ELSE
235  NULLIFY(solver_equations%SOLVER_MATRICES)
236  CALL solver_matrices_initialise(solver_equations,err,error,*999)
237  solver_matrices=>solver_equations%SOLVER_MATRICES
238  ENDIF
239  ELSE
240  CALL flagerror("Solver equations are not finished",err,error,*998)
241  ENDIF
242  ELSE
243  CALL flagerror("Solver is not associated",err,error,*998)
244  ENDIF
245 
246  exits("SOLVER_MATRICES_CREATE_START")
247  RETURN
248 999 CALL solver_matrices_finalise(solver_equations%SOLVER_MATRICES,dummy_err,dummy_error,*998)
249 998 errorsexits("SOLVER_MATRICES_CREATE_START",err,error)
250  RETURN 1
251 
252  END SUBROUTINE solver_matrices_create_start
253 
254  !
255  !================================================================================================================================
256  !
257 
259  SUBROUTINE solver_matrices_destroy(SOLVER_MATRICES,ERR,ERROR,*)
261  !Argument variables
262  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
263  INTEGER(INTG), INTENT(OUT) :: ERR
264  TYPE(varying_string), INTENT(OUT) :: ERROR
265  !Local Variables
266 
267  enters("SOLVER_MATRICES_DESTROY",err,error,*999)
268 
269  IF(ASSOCIATED(solver_matrices)) THEN
270  CALL solver_matrices_finalise(solver_matrices,err,error,*999)
271  ELSE
272  CALL flagerror("Solver matrices is not associated",err,error,*999)
273  ENDIF
274 
275  exits("SOLVER_MATRICES_DESTROY")
276  RETURN
277 999 errorsexits("SOLVER_MATRICES_DESTROY",err,error)
278  RETURN 1
279 
280  END SUBROUTINE solver_matrices_destroy
281 
282  !
283  !================================================================================================================================
284  !
285 
287  SUBROUTINE solver_matrices_finalise(SOLVER_MATRICES,ERR,ERROR,*)
289  !Argument variables
290  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
291  INTEGER(INTG), INTENT(OUT) :: ERR
292  TYPE(varying_string), INTENT(OUT) :: ERROR
293  !Local Variables
294  INTEGER(INTG) :: matrix_idx
295 
296  enters("SOLVER_MATRICES_FINALISE",err,error,*999)
297 
298  IF(ASSOCIATED(solver_matrices)) THEN
299  IF(ALLOCATED(solver_matrices%MATRICES)) THEN
300  DO matrix_idx=1,SIZE(solver_matrices%MATRICES,1)
301  CALL solver_matrix_finalise(solver_matrices%MATRICES(matrix_idx)%PTR,err,error,*999)
302  ENDDO !matrix_idx
303  DEALLOCATE(solver_matrices%MATRICES)
304  ENDIF
305  IF(ASSOCIATED(solver_matrices%RESIDUAL)) CALL distributed_vector_destroy(solver_matrices%RESIDUAL,err,error,*999)
306  IF(ASSOCIATED(solver_matrices%RHS_VECTOR)) CALL distributed_vector_destroy(solver_matrices%RHS_VECTOR,err,error,*999)
307  DEALLOCATE(solver_matrices)
308  ENDIF
309 
310  exits("SOLVER_MATRICES_FINALISE")
311  RETURN
312 999 errorsexits("SOLVER_MATRICES_FINALISE",err,error)
313  RETURN 1
314 
315  END SUBROUTINE solver_matrices_finalise
316 
317  !
318  !================================================================================================================================
319  !
320 
322  SUBROUTINE solver_matrices_initialise(SOLVER_EQUATIONS,ERR,ERROR,*)
324  !Argument variables
325  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
326  INTEGER(INTG), INTENT(OUT) :: ERR
327  TYPE(varying_string), INTENT(OUT) :: ERROR
328  !Local Variables
329  INTEGER(INTG) :: DUMMY_ERR,equations_matrix_idx,equations_set_idx,matrix_idx
330  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
331  TYPE(varying_string) :: DUMMY_ERROR
332 
333  enters("SOLVER_MATRICES_INITIALISE",err,error,*998)
334 
335  IF(ASSOCIATED(solver_equations)) THEN
336  IF(ASSOCIATED(solver_equations%SOLVER_MATRICES)) THEN
337  CALL flagerror("Solver matrices is already associated for this solver equations.",err,error,*998)
338  ELSE
339  solver_mapping=>solver_equations%SOLVER_MAPPING
340  IF(ASSOCIATED(solver_mapping)) THEN
341  ALLOCATE(solver_equations%SOLVER_MATRICES,stat=err)
342  IF(err/=0) CALL flagerror("Could not allocate solver matrices.",err,error,*999)
343  solver_equations%SOLVER_MATRICES%SOLVER_EQUATIONS=>solver_equations
344  solver_equations%SOLVER_MATRICES%SOLVER_MATRICES_FINISHED=.false.
345  solver_equations%SOLVER_MATRICES%SOLVER_MAPPING=>solver_mapping
346  solver_equations%SOLVER_MATRICES%NUMBER_OF_ROWS=solver_mapping%NUMBER_OF_ROWS
347  solver_equations%SOLVER_MATRICES%NUMBER_OF_GLOBAL_ROWS=solver_mapping%NUMBER_OF_GLOBAL_ROWS
348  solver_equations%SOLVER_MATRICES%LIBRARY_TYPE=distributed_matrix_vector_petsc_type
349  solver_equations%SOLVER_MATRICES%NUMBER_OF_MATRICES=solver_mapping%NUMBER_OF_SOLVER_MATRICES
350  ALLOCATE(solver_equations%SOLVER_MATRICES%MATRICES(solver_mapping%NUMBER_OF_SOLVER_MATRICES),stat=err)
351  IF(err/=0) CALL flagerror("Could not allocate solver matrices matrices.",err,error,*999)
352  DO matrix_idx=1,solver_mapping%NUMBER_OF_SOLVER_MATRICES
353  NULLIFY(solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR)
354  CALL solver_matrix_initialise(solver_equations%SOLVER_MATRICES,matrix_idx,err,error,*999)
355  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
356  IF(ALLOCATED(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
357  & matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS)) THEN
358  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
359  & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
360  !Add the solver matrix to the solvers mapping
361  solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
362  & matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR%SOLVER_MATRIX=> &
363  & solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
364  ENDDO !equations_matrix_idx
365  ELSE
366  IF(ALLOCATED(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
367  & equations_to_solver_matrix_maps_sm(matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS)) THEN
368  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
369  & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
370  solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
371  & equations_to_solver_matrix_maps_sm(matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR% &
372  & solver_matrix=>solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
373  ENDDO
374  ELSE
375  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
376  & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
377  !Add the solver matrix to the solvers mapping
378  solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
379  & matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR%SOLVER_MATRIX=> &
380  & solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
381  ENDDO !equations_matrix_idx
382  ENDIF
383  ENDIF
384  ENDDO !equations_set_idx
385  ENDDO !matrix_idx
386  IF(solver_equations%LINEARITY==problem_solver_nonlinear) THEN
387  solver_equations%SOLVER_MATRICES%UPDATE_RESIDUAL=.true.
388  ELSE
389  solver_equations%SOLVER_MATRICES%UPDATE_RESIDUAL=.false.
390  ENDIF
391  NULLIFY(solver_equations%SOLVER_MATRICES%RESIDUAL)
392  solver_equations%SOLVER_MATRICES%UPDATE_RHS_VECTOR=.true.
393  NULLIFY(solver_equations%SOLVER_MATRICES%RHS_VECTOR)
394  ELSE
395  CALL flagerror("Solver equations solver mapping is not associated",err,error,*999)
396  ENDIF
397  ENDIF
398  ELSE
399  CALL flagerror("Solver equations is not associated",err,error,*998)
400  ENDIF
401 
402  exits("SOLVER_MATRICES_INITIALISE")
403  RETURN
404 999 CALL solver_matrices_finalise(solver_equations%SOLVER_MATRICES,dummy_err,dummy_error,*998)
405 998 errorsexits("SOLVER_MATRICES_INITIALISE",err,error)
406  RETURN 1
407 
408  END SUBROUTINE solver_matrices_initialise
409 
410  !
411  !================================================================================================================================
412  !
413 
415  SUBROUTINE solver_matrices_library_type_get(SOLVER_MATRICES,LIBRARY_TYPE,ERR,ERROR,*)
417  !Argument variables
418  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
419  INTEGER(INTG), INTENT(OUT) :: LIBRARY_TYPE
420  INTEGER(INTG), INTENT(OUT) :: ERR
421  TYPE(varying_string), INTENT(OUT) :: ERROR
422  !Local Variables
423 
424  enters("SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
425 
426  IF(ASSOCIATED(solver_matrices)) THEN
427  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
428  library_type=solver_matrices%LIBRARY_TYPE
429  ELSE
430  CALL flagerror("Solver matrices has not finished.",err,error,*999)
431  ENDIF
432  ELSE
433  CALL flagerror("Solver matrices is not associated.",err,error,*999)
434  ENDIF
435 
436  exits("SOLVER_MATRICES_LIBRARY_TYPE_GET")
437  RETURN
438 999 errorsexits("SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error)
439  RETURN
440  END SUBROUTINE solver_matrices_library_type_get
441 
442 
443  !
444  !================================================================================================================================
445  !
446 
448  SUBROUTINE solver_matrices_library_type_set(SOLVER_MATRICES,LIBRARY_TYPE,ERR,ERROR,*)
450  !Argument variables
451  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
452  INTEGER(INTG), INTENT(IN) :: LIBRARY_TYPE
453  INTEGER(INTG), INTENT(OUT) :: ERR
454  TYPE(varying_string), INTENT(OUT) :: ERROR
455  !Local Variables
456  TYPE(varying_string) :: LOCAL_ERROR
457 
458  enters("SOLVER_MATRICES_LIBRARY_TYPE_SET",err,error,*999)
459 
460  IF(ASSOCIATED(solver_matrices)) THEN
461  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
462  CALL flagerror("Solver matrices has been finished.",err,error,*999)
463  ELSE
464  SELECT CASE(library_type)
466  solver_matrices%LIBRARY_TYPE=distributed_matrix_vector_cmiss_type
468  solver_matrices%LIBRARY_TYPE=distributed_matrix_vector_petsc_type
469  CASE DEFAULT
470  local_error="The library type of "// trim(number_to_vstring(library_type,"*",err,error))//" is invalid."
471  CALL flagerror(local_error,err,error,*999)
472  END SELECT
473  ENDIF
474  ELSE
475  CALL flagerror("Solver matrices is not associated.",err,error,*999)
476  ENDIF
477 
478  exits("SOLVER_MATRICES_LIBRARY_TYPE_SET")
479  RETURN
480 999 errorsexits("SOLVER_MATRICES_LIBRARY_TYPE_SET",err,error)
481  RETURN 1
482  END SUBROUTINE solver_matrices_library_type_set
483 
484  !
485  !================================================================================================================================
486  !
487 
489  SUBROUTINE solver_matrices_output(ID,SELECTION_TYPE,SOLVER_MATRICES,ERR,ERROR,*)
491  !Argument variables
492  INTEGER(INTG), INTENT(IN) :: ID
493  INTEGER(INTG), INTENT(IN) :: SELECTION_TYPE
494  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
495  INTEGER(INTG), INTENT(OUT) :: ERR
496  TYPE(varying_string), INTENT(OUT) :: ERROR
497  !Local Variables
498  INTEGER(INTG) :: matrix_idx
499  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
500 
501  enters("SOLVER_MATRICES_OUTPUT",err,error,*999)
502 
503  IF(ASSOCIATED(solver_matrices)) THEN
504  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
505  CALL write_string(id,"",err,error,*999)
506  IF(selection_type==solver_matrices_all.OR. &
507 ! & SELECTION_TYPE==SOLVER_MATRICES_DYNAMIC_ONLY.OR. &
508  & selection_type==solver_matrices_linear_only.OR. &
509  & selection_type==solver_matrices_nonlinear_only.OR. &
510  & selection_type==solver_matrices_jacobian_only) THEN
511  CALL write_string(id,"Solver matrices:",err,error,*999)
512  CALL write_string_value(id,"Number of matrices = ",solver_matrices%NUMBER_OF_MATRICES,err,error,*999)
513  DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
514  solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
515  IF(ASSOCIATED(solver_matrix)) THEN
516  CALL write_string_value(id,"Solver matrix : ",matrix_idx,err,error,*999)
517  CALL distributed_matrix_output(id,solver_matrix%MATRIX,err,error,*999)
518  ELSE
519  CALL flagerror("Solver matrix is not associated.",err,error,*999)
520  ENDIF
521  ENDDO !matrix_idx
522  ENDIF
523  IF(selection_type==solver_matrices_all.OR. &
524  & selection_type==solver_matrices_nonlinear_only.OR. &
525  & selection_type==solver_matrices_residual_only.OR. &
526  & selection_type==solver_matrices_rhs_residual_only) THEN
527  IF(ASSOCIATED(solver_matrices%RESIDUAL)) THEN
528  CALL write_string(id,"Solver residual vector:",err,error,*999)
529  CALL distributed_vector_output(id,solver_matrices%RESIDUAL,err,error,*999)
530  ENDIF
531  ENDIF
532  IF(selection_type==solver_matrices_all.OR. &
533 ! & SELECTION_TYPE==SOLVER_MATRICES_DYNAMIC_ONLY.OR. &
534  & selection_type==solver_matrices_linear_only.OR. &
535  & selection_type==solver_matrices_nonlinear_only.OR. &
536  & selection_type==solver_matrices_rhs_only.OR. &
537  & selection_type==solver_matrices_rhs_residual_only) THEN
538  IF(ASSOCIATED(solver_matrices%RHS_VECTOR)) THEN
539  CALL write_string(id,"Solver RHS vector:",err,error,*999)
540  CALL distributed_vector_output(id,solver_matrices%RHS_VECTOR,err,error,*999)
541  ENDIF
542  ENDIF
543  ELSE
544  CALL flagerror("Solver matrices have not been finished.",err,error,*999)
545  ENDIF
546  ELSE
547  CALL flagerror("Solver matrices is not associated.",err,error,*999)
548  ENDIF
549 
550  exits("SOLVER_MATRICES_OUTPUT")
551  RETURN
552 999 errorsexits("SOLVER_MATRICES_OUTPUT",err,error)
553  RETURN 1
554  END SUBROUTINE solver_matrices_output
555 
556  !
557  !================================================================================================================================
558  !
559 
561  SUBROUTINE solver_matrices_storage_type_get(SOLVER_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
563  !Argument variables
564  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
565  INTEGER(INTG), INTENT(OUT) :: STORAGE_TYPE(:)
566  INTEGER(INTG), INTENT(OUT) :: ERR
567  TYPE(varying_string), INTENT(OUT) :: ERROR
568  !Local Variables
569  INTEGER(INTG) :: matrix_idx
570  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
571  TYPE(varying_string) :: LOCAL_ERROR
572 
573  enters("SOLVER_MATRICES_STORAGE_TYPE_GET",err,error,*999)
574 
575  IF(ASSOCIATED(solver_matrices)) THEN
576  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
577  IF(SIZE(storage_type,1)>=solver_matrices%NUMBER_OF_MATRICES) THEN
578  DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
579  solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
580  IF(ASSOCIATED(solver_matrix)) THEN
581  storage_type(matrix_idx)=solver_matrix%STORAGE_TYPE
582  ELSE
583  CALL flagerror("Solver matrix is not associated.",err,error,*999)
584  ENDIF
585  ENDDO !matrix_idx
586  ELSE
587  local_error="The size of STORAGE_TYPE is too small. The supplied size is "// &
588  & trim(number_to_vstring(SIZE(storage_type,1),"*",err,error))//" and it needs to be >= "// &
589  & trim(number_to_vstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))//"."
590  CALL flagerror(local_error,err,error,*999)
591  ENDIF
592  ELSE
593  CALL flagerror("Solver matrices have not finished.",err,error,*999)
594  ENDIF
595  ELSE
596  CALL flagerror("Solver matrices is not associated.",err,error,*999)
597  ENDIF
598 
599  exits("SOLVER_MATRICES_STORAGE_TYPE_GET")
600  RETURN
601 999 errorsexits("SOLVER_MATRICES_STORAGE_TYPE_GET",err,error)
602  RETURN 1
603  END SUBROUTINE solver_matrices_storage_type_get
604 
605  !
606  !================================================================================================================================
607  !
608 
610  SUBROUTINE solver_matrices_storage_type_set(SOLVER_MATRICES,STORAGE_TYPE,ERR,ERROR,*)
612  !Argument variables
613  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
614  INTEGER(INTG), INTENT(IN) :: STORAGE_TYPE(:)
615  INTEGER(INTG), INTENT(OUT) :: ERR
616  TYPE(varying_string), INTENT(OUT) :: ERROR
617  !Local Variables
618  INTEGER(INTG) :: matrix_idx
619  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
620  TYPE(varying_string) :: LOCAL_ERROR
621 
622  enters("SOLVER_MATRICES_STORAGE_TYPE_SET",err,error,*999)
623 
624  IF(ASSOCIATED(solver_matrices)) THEN
625  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
626  CALL flagerror("Solver matrices have been finished.",err,error,*999)
627  ELSE
628  IF(SIZE(storage_type,1)==solver_matrices%NUMBER_OF_MATRICES) THEN
629  DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
630  solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
631  IF(ASSOCIATED(solver_matrix)) THEN
632  SELECT CASE(storage_type(matrix_idx))
634  solver_matrix%STORAGE_TYPE=matrix_block_storage_type
636  solver_matrix%STORAGE_TYPE=matrix_diagonal_storage_type
638  solver_matrix%STORAGE_TYPE=matrix_column_major_storage_type
640  solver_matrix%STORAGE_TYPE=matrix_row_major_storage_type
642  solver_matrix%STORAGE_TYPE=matrix_compressed_row_storage_type
644  solver_matrix%STORAGE_TYPE=matrix_compressed_column_storage_type
646  solver_matrix%STORAGE_TYPE=matrix_row_column_storage_type
647  CASE DEFAULT
648  local_error="The specified storage type of "//trim(number_to_vstring(storage_type(matrix_idx),"*",err,error))// &
649  & " for the matrix number "//trim(number_to_vstring(matrix_idx,"*",err,error))//" is invalid."
650  CALL flagerror(local_error,err,error,*999)
651  END SELECT
652  ELSE
653  CALL flagerror("Solver matrix is not associated.",err,error,*999)
654  ENDIF
655  ENDDO !matrix_idx
656  ELSE
657  local_error="The size of the storage type array ("//trim(number_to_vstring(SIZE(storage_type,1),"*",err,error))// &
658  & ") is not equal to the number of matrices ("// &
659  & trim(number_to_vstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))//")."
660  CALL flagerror(local_error,err,error,*999)
661  ENDIF
662  ENDIF
663  ELSE
664  CALL flagerror("Solver matrices is not associated.",err,error,*999)
665  ENDIF
666 
667  exits("SOLVER_MATRICES_STORAGE_TYPE_SET")
668  RETURN
669 999 errorsexits("SOLVER_MATRICES_STORAGE_TYPE_SET",err,error)
670  RETURN 1
671  END SUBROUTINE solver_matrices_storage_type_set
672 
673  !
674  !================================================================================================================================
675  !
676 
678  SUBROUTINE solver_matrix_equations_matrix_add(SOLVER_MATRIX,equations_set_idx,ALPHA,EQUATIONS_MATRIX,ERR,ERROR,*)
680  !Argument variables
681  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
682  INTEGER(INTG), INTENT(IN) :: equations_set_idx
683  REAL(DP), INTENT(IN) :: ALPHA
684  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
685  INTEGER(INTG), INTENT(OUT) :: ERR
686  TYPE(varying_string), INTENT(OUT) :: ERROR
687  !Local Variables
688  INTEGER(INTG) :: equations_column_idx,equations_column_number,equations_row_number,EQUATIONS_STORAGE_TYPE, &
689  & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
690  INTEGER(INTG), POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
691  REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
692  REAL(DP), POINTER :: EQUATIONS_MATRIX_DATA(:)
693  TYPE(distributed_matrix_type), POINTER :: EQUATIONS_DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
694  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
695  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
696  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
697  TYPE(equations_to_solver_maps_type), POINTER :: EQUATIONS_TO_SOLVER_MAP
698  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
699  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
700  TYPE(varying_string) :: LOCAL_ERROR
701 
702  enters("SOLVER_MATRIX_EQUATIONS_MATRIX_ADD",err,error,*999)
703 
704  NULLIFY(equations_matrix_data)
705  NULLIFY(column_indices)
706  NULLIFY(row_indices)
707 
708  IF(ASSOCIATED(solver_matrix)) THEN
709  IF(ASSOCIATED(equations_matrix)) THEN
710  IF(abs(alpha)>zero_tolerance) THEN
711  solver_matrices=>solver_matrix%SOLVER_MATRICES
712  IF(ASSOCIATED(solver_matrices)) THEN
713  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
714  solver_mapping=>solver_matrices%SOLVER_MAPPING
715  IF(ASSOCIATED(solver_mapping)) THEN
716  linear_matrices=>equations_matrix%LINEAR_MATRICES
717  dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
718  IF(ASSOCIATED(dynamic_matrices).OR.ASSOCIATED(linear_matrices)) THEN
719  IF(ASSOCIATED(dynamic_matrices)) THEN
720  equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
721  ELSE
722  equations_matrices=>linear_matrices%EQUATIONS_MATRICES
723  ENDIF
724  IF(ASSOCIATED(equations_matrices)) THEN
725  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
726  IF(equations_set_idx>0.AND.equations_set_idx<=solver_mapping%NUMBER_OF_EQUATIONS_SETS) THEN
727  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
728  & equations_to_solver_matrix_maps_em(equations_matrix%MATRIX_NUMBER)% &
729  & equations_to_solver_matrix_maps(solver_matrix%MATRIX_NUMBER)%PTR
730  IF(ASSOCIATED(equations_to_solver_map)) THEN
731  solver_distributed_matrix=>solver_matrix%MATRIX
732  IF(ASSOCIATED(solver_distributed_matrix)) THEN
733  equations_distributed_matrix=>equations_matrix%MATRIX
734  IF(ASSOCIATED(equations_distributed_matrix)) THEN
735  CALL distributed_matrix_storage_type_get(equations_distributed_matrix,equations_storage_type, &
736  & err,error,*999)
737  CALL distributed_matrix_data_get(equations_distributed_matrix,equations_matrix_data,err,error,*999)
738  SELECT CASE(equations_storage_type)
740  !Loop over the rows of the equations matrix
741  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
742  !Loop over the solution rows this equations row is mapped to
743  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
744  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
745  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
746  & equations_row_to_solver_rows_maps(equations_row_number)% &
747  & solver_rows(solver_row_idx)
748  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
749  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
750  & coupling_coefficients(solver_row_idx)
751  !Loop over the columns of the equations matrix
752  DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
753  !Loop over the solution columns this equations column is mapped to
754  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
755  & equations_column_number)%NUMBER_OF_SOLVER_COLS
756  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
757  & equations_column_number)%SOLVER_COLS(solver_column_idx)
758  column_coupling_coefficient=equations_to_solver_map% &
759  & equations_col_to_solver_cols_map(equations_column_number)% &
760  & coupling_coefficients(solver_column_idx)
761  !Add in the solver matrix value
762  VALUE=alpha*equations_matrix_data(equations_row_number+ &
763  & (equations_column_number-1)*equations_matrices%TOTAL_NUMBER_OF_ROWS)* &
764  & row_coupling_coefficient*column_coupling_coefficient
765  CALL distributed_matrix_values_add(solver_distributed_matrix, &
766  & solver_row_number,solver_column_number,VALUE,err,error,*999)
767  ENDDO !solver_column_idx
768  ENDDO !equations_column_number
769  ENDDO !solver_row_idx
770  ENDDO !equations_row_number
772  !Loop over the rows of the equations matrix
773  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
774  !Loop over the solution rows this equations row is mapped to
775  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
776  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
777  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
778  & equations_row_to_solver_rows_maps(equations_row_number)% &
779  & solver_rows(solver_row_idx)
780  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
781  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
782  & coupling_coefficients(solver_row_idx)
783  equations_column_number=equations_row_number
784  !Loop over the solution columns this equations column is mapped to
785  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
786  & equations_column_number)%NUMBER_OF_SOLVER_COLS
787  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
788  & equations_column_number)%SOLVER_COLS(solver_column_idx)
789  column_coupling_coefficient=equations_to_solver_map% &
790  & equations_col_to_solver_cols_map(equations_column_number)% &
791  & coupling_coefficients(solver_column_idx)
792  !Add in the solver matrix value
793  VALUE=alpha*equations_matrix_data(equations_row_number)* &
794  & row_coupling_coefficient*column_coupling_coefficient
795  CALL distributed_matrix_values_add(solver_distributed_matrix, &
796  & solver_row_number,solver_column_number,VALUE,err,error,*999)
797  ENDDO !solver_column_idx
798  ENDDO !solver_row_idx
799  ENDDO !equations_row_number
801  CALL flagerror("Not implemented.",err,error,*999)
803  CALL flagerror("Not implemented.",err,error,*999)
805  CALL distributed_matrix_storage_locations_get(equations_distributed_matrix, &
806  & row_indices,column_indices,err,error,*999)
807  !Loop over the rows of the equations matrix
808  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
809  !Loop over the solution rows this equations row is mapped to
810  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
811  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
812  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
813  & equations_row_to_solver_rows_maps(equations_row_number)% &
814  & solver_rows(solver_row_idx)
815  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
816  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
817  & coupling_coefficients(solver_row_idx)
818  !Loop over the columns of the equations matrix
819  DO equations_column_idx=row_indices(equations_row_number),row_indices(equations_row_number+1)-1
820  equations_column_number=column_indices(equations_column_idx)
821  !Loop over the solution columns this equations column is mapped to
822  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
823  & equations_column_number)%NUMBER_OF_SOLVER_COLS
824  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
825  & equations_column_number)%SOLVER_COLS(solver_column_idx)
826  column_coupling_coefficient=equations_to_solver_map% &
827  & equations_col_to_solver_cols_map(equations_column_number)% &
828  & coupling_coefficients(solver_column_idx)
829  !Add in the solver matrix value
830  VALUE=alpha*equations_matrix_data(equations_column_idx)*row_coupling_coefficient* &
831  & column_coupling_coefficient
832  CALL distributed_matrix_values_add(solver_distributed_matrix, &
833  & solver_row_number,solver_column_number,VALUE,err,error,*999)
834  ENDDO !solution_column_idx
835  ENDDO !equations_column_idx
836  ENDDO !solution_row_idx
837  ENDDO !equations_row_number
839  CALL flagerror("Not implemented.",err,error,*999)
841  CALL flagerror("Not implemented.",err,error,*999)
842  CASE DEFAULT
843  local_error="The equations matrix storage type of "// &
844  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
845  CALL flagerror(local_error,err,error,*999)
846  END SELECT
847  CALL distributed_matrix_data_restore(equations_distributed_matrix,equations_matrix_data, &
848  & err,error,*999)
849  ELSE
850  CALL flagerror("The equations matrix distributed matrix is not associated",err,error,*999)
851  ENDIF
852  ELSE
853  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
854  ENDIF
855  ELSE
856  CALL flagerror("Equations to solver map is not associated.",err,error,*999)
857  ENDIF
858  ELSE
859  local_error="The specified equations set index of "// &
860  & trim(number_to_vstring(equations_set_idx,"*",err,error))// &
861  & " is invalid. The equations set index needs to be between 1 and "// &
862  & trim(number_to_vstring(solver_mapping%NUMBER_OF_EQUATIONS_SETS,"*",err,error))//"."
863  CALL flagerror(local_error,err,error,*999)
864  ENDIF
865  ELSE
866  CALL flagerror("Equations matrices have not been finished.",err,error,*999)
867  ENDIF
868  ELSE
869  CALL flagerror("Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
870  ENDIF
871  ELSE
872  CALL flagerror("Equations matrix dynamic or linear matrices is not associated.",err,error,*999)
873  ENDIF
874  ELSE
875  CALL flagerror("Solver matrices solver mapping is not associated.",err,error,*999)
876  ENDIF
877  ELSE
878  CALL flagerror("Solver matrices have not been finished.",err,error,*999)
879  ENDIF
880  ELSE
881  CALL flagerror("Solver matrix solver matrices is not associated.",err,error,*999)
882  ENDIF
883  ENDIF
884  ELSE
885  CALL flagerror("Equations matrix is not associated.",err,error,*999)
886  ENDIF
887  ELSE
888  CALL flagerror("Solver matrix is not associated.",err,error,*999)
889  ENDIF
890 
891  exits("SOLVER_MATRIX_EQUATIONS_MATRIX_ADD")
892  RETURN
893 999 errorsexits("SOLVER_MATRIX_EQUATIONS_MATRIX_ADD",err,error)
894  RETURN 1
896 
897  !
898  !================================================================================================================================
899  !
900 
902  SUBROUTINE solver_matrix_interface_matrix_add(SOLVER_MATRIX,interface_condition_idx,ALPHA,INTERFACE_MATRIX,ERR,ERROR,*)
904  !Argument variables
905  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
906  INTEGER(INTG), INTENT(IN) :: interface_condition_idx
907  REAL(DP), INTENT(IN) :: ALPHA(2)
908  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
909  INTEGER(INTG), INTENT(OUT) :: ERR
910  TYPE(varying_string), INTENT(OUT) :: ERROR
911  !Local Variables
912  INTEGER(INTG) :: interface_column_idx,interface_column_number,interface_row_idx,interface_row_number,INTERFACE_STORAGE_TYPE, &
913  & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
914  INTEGER(INTG), POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
915  REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
916  REAL(DP), POINTER :: INTERFACE_MATRIX_DATA(:)
917  TYPE(distributed_matrix_type), POINTER :: INTERFACE_DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
918  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
919  TYPE(interface_to_solver_maps_type), POINTER :: INTERFACE_TO_SOLVER_MAP
920  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
921  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
922  TYPE(varying_string) :: LOCAL_ERROR
923 
924  enters("SOLVER_MATRIX_INTERFACE_MATRIX_ADD",err,error,*999)
925 
926  NULLIFY(interface_matrix_data)
927  NULLIFY(column_indices)
928  NULLIFY(row_indices)
929 
930  IF(ASSOCIATED(solver_matrix)) THEN
931  IF(ASSOCIATED(interface_matrix)) THEN
932  IF(abs(alpha(1))>zero_tolerance) THEN
933  solver_matrices=>solver_matrix%SOLVER_MATRICES
934  IF(ASSOCIATED(solver_matrices)) THEN
935  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
936  solver_mapping=>solver_matrices%SOLVER_MAPPING
937  IF(ASSOCIATED(solver_mapping)) THEN
938  interface_matrices=>interface_matrix%INTERFACE_MATRICES
939  IF(ASSOCIATED(interface_matrices)) THEN
940  IF(interface_matrices%INTERFACE_MATRICES_FINISHED) THEN
941  IF(interface_condition_idx>0.AND.interface_condition_idx<=solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS) THEN
942  interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
943  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)%INTERFACE_TO_SOLVER_MATRIX_MAPS( &
944  & solver_matrix%MATRIX_NUMBER)%PTR
945  IF(ASSOCIATED(interface_to_solver_map)) THEN
946  solver_distributed_matrix=>solver_matrix%MATRIX
947  IF(ASSOCIATED(solver_distributed_matrix)) THEN
948  interface_distributed_matrix=>interface_matrix%MATRIX
949  IF(ASSOCIATED(interface_distributed_matrix)) THEN
950  CALL distributed_matrix_storage_type_get(interface_distributed_matrix,interface_storage_type, &
951  & err,error,*999)
952  CALL distributed_matrix_data_get(interface_distributed_matrix,interface_matrix_data,err,error,*999)
953  SELECT CASE(interface_storage_type)
955  !Loop over the rows of the interface matrix
956  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
957  !Loop over the solution rows this interface row is mapped to
958  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
959  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
960  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
961  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
962  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
963  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
964  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
965  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
966  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
967  !Loop over the columns of the interface matrix
968  DO interface_column_number=1,interface_matrices%TOTAL_NUMBER_OF_COLUMNS
969  !Loop over the solution columns this interface column is mapped to
970  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
971  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
972  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
973  & interface_column_number)%NUMBER_OF_SOLVER_COLS
974  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
975  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
976  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
977  & interface_column_number)%SOLVER_COLS(solver_column_idx)
978  column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
979  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
980  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
981  & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
982  !Add in the solver matrix value
983  VALUE=alpha(1)*interface_matrix_data(interface_row_number+ &
984  & (interface_column_number-1)*interface_matrix%TOTAL_NUMBER_OF_ROWS)* &
985  & row_coupling_coefficient*column_coupling_coefficient
986  CALL distributed_matrix_values_add(solver_distributed_matrix, &
987  & solver_row_number,solver_column_number,VALUE,err,error,*999)
988  ENDDO !solver_column_idx
989  ENDDO !interface_column_number
990  ENDDO !solver_row_idx
991  ENDDO !interface_row_number
993  !Loop over the rows of the interface matrix
994  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
995  !Loop over the solution rows this interface row is mapped to
996  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
997  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
998  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
999  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1000  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1001  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
1002  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1003  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
1004  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
1005  interface_column_number=interface_row_number
1006  !Loop over the solution columns this interface column is mapped to
1007  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1008  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1009  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1010  & interface_column_number)%NUMBER_OF_SOLVER_COLS
1011  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1012  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1013  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1014  & interface_column_number)%SOLVER_COLS(solver_column_idx)
1015  column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1016  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1017  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1018  & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1019  !Add in the solver matrix value
1020  VALUE=alpha(1)*interface_matrix_data(interface_row_number)* &
1021  & row_coupling_coefficient*column_coupling_coefficient
1022  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1023  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1024  ENDDO !solver_column_idx
1025  ENDDO !solver_row_idx
1026  ENDDO !interface_row_number
1028  CALL flagerror("Not implemented.",err,error,*999)
1030  CALL flagerror("Not implemented.",err,error,*999)
1032  CALL distributed_matrix_storage_locations_get(interface_distributed_matrix, &
1033  & row_indices,column_indices,err,error,*999)
1034  !Loop over the rows of the interface matrix
1035  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
1036  !Loop over the solution rows this interface row is mapped to
1037  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1038  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1039  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
1040  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1041  & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1042  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
1043  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1044  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
1045  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
1046  !Loop over the columns of the interface matrix
1047  DO interface_column_idx=row_indices(interface_row_number),row_indices(interface_row_number+1)-1
1048  interface_column_number=column_indices(interface_column_idx)
1049  !Loop over the solution columns this interface column is mapped to
1050  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1051  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1052  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1053  & interface_column_number)%NUMBER_OF_SOLVER_COLS
1054  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1055  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1056  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1057  & interface_column_number)%SOLVER_COLS(solver_column_idx)
1058  column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1059  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1060  & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1061  & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1062  !Add in the solver matrix value
1063  VALUE=alpha(1)*interface_matrix_data(interface_column_idx)*row_coupling_coefficient* &
1064  & column_coupling_coefficient
1065  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1066  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1067  ENDDO !solution_column_idx
1068  ENDDO !interface_column_idx
1069  ENDDO !solution_row_idx
1070  ENDDO !interface_row_number
1072  CALL flagerror("Not implemented.",err,error,*999)
1074  CALL flagerror("Not implemented.",err,error,*999)
1075  CASE DEFAULT
1076  local_error="The interface matrix storage type of "// &
1077  & trim(number_to_vstring(interface_storage_type,"*",err,error))//" is invalid."
1078  CALL flagerror(local_error,err,error,*999)
1079  END SELECT
1080  CALL distributed_matrix_data_restore(interface_distributed_matrix,interface_matrix_data, &
1081  & err,error,*999)
1082  IF(interface_matrix%HAS_TRANSPOSE) THEN
1083  IF(abs(alpha(2))>zero_tolerance) THEN
1084  interface_distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
1085  IF(ASSOCIATED(interface_distributed_matrix)) THEN
1086  CALL distributed_matrix_storage_type_get(interface_distributed_matrix,interface_storage_type, &
1087  & err,error,*999)
1088  CALL distributed_matrix_data_get(interface_distributed_matrix,interface_matrix_data, &
1089  & err,error,*999)
1090  SELECT CASE(interface_storage_type)
1092  !Loop over the columns of the interface matrix
1093  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1094  !Loop over the solver rows this interface column is mapped to
1095  DO solver_row_idx=1,solver_mapping% &
1096  & interface_condition_to_solver_map(interface_condition_idx)% &
1097  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1098  solver_row_number=solver_mapping% &
1099  & interface_condition_to_solver_map(interface_condition_idx)% &
1100  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1101  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1102  & interface_condition_idx)% &
1103  & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1104  !Loop over the rows of the interface matrix
1105  DO interface_row_number=1,interface_matrix%TOTAL_NUMBER_OF_ROWS
1106  !Loop over the solver columns this interface row is mapped to
1107  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1108  & interface_row_number)%NUMBER_OF_SOLVER_COLS
1109  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1110  & interface_row_number)%SOLVER_COLS(solver_column_idx)
1111  column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1112  & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1113  !Add in the solver matrix value
1114  VALUE=alpha(2)*interface_matrix_data(interface_column_number+ &
1115  & (interface_row_number-1)*interface_matrices%TOTAL_NUMBER_OF_COLUMNS)* &
1116  & row_coupling_coefficient*column_coupling_coefficient
1117  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1118  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1119  ENDDO !solver_column_idx
1120  ENDDO !interface_row_number
1121  ENDDO !solver_row_idx
1122  ENDDO !interface_column_number
1124  !Loop over the columns of the interface matrix
1125  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1126  !Loop over the solver rows this interface column is mapped to
1127  DO solver_row_idx=1,solver_mapping% &
1128  & interface_condition_to_solver_map(interface_condition_idx)% &
1129  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1130  solver_row_number=solver_mapping% &
1131  & interface_condition_to_solver_map(interface_condition_idx)% &
1132  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1133  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1134  & interface_condition_idx)% &
1135  & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1136  interface_row_number=interface_column_number
1137  !Loop over the solver columns this interface row is mapped to
1138  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1139  & interface_row_number)%NUMBER_OF_SOLVER_COLS
1140  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1141  & interface_row_number)%SOLVER_COLS(solver_column_idx)
1142  column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1143  & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1144  !Add in the solver matrix value
1145  VALUE=alpha(2)*interface_matrix_data(interface_column_number)* &
1146  & row_coupling_coefficient*column_coupling_coefficient
1147  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1148  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1149  ENDDO !solver_column_idx
1150  ENDDO !solver_row_idx
1151  ENDDO !interface_column_number
1153  CALL flagerror("Not implemented.",err,error,*999)
1155  CALL flagerror("Not implemented.",err,error,*999)
1157  CALL distributed_matrix_storage_locations_get(interface_distributed_matrix, &
1158  & row_indices,column_indices,err,error,*999)
1159  !Loop over the columns of the interface matrix
1160  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1161  !Loop over the solver rows this interface column is mapped to
1162  DO solver_row_idx=1,solver_mapping% &
1163  & interface_condition_to_solver_map(interface_condition_idx)% &
1164  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1165  solver_row_number=solver_mapping% &
1166  & interface_condition_to_solver_map(interface_condition_idx)% &
1167  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1168  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1169  & interface_condition_idx)% &
1170  & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1171  !Loop over the rows of the interface matrix
1172  DO interface_row_idx=row_indices(interface_column_number), &
1173  & row_indices(interface_column_number+1)-1
1174  interface_row_number=column_indices(interface_row_idx)
1175  !Loop over the solver columns this interface row is mapped to
1176  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1177  & interface_row_number)%NUMBER_OF_SOLVER_COLS
1178  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1179  & interface_row_number)%SOLVER_COLS(solver_column_idx)
1180  column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1181  & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1182  !Add in the solver matrix value
1183  VALUE=alpha(2)*interface_matrix_data(interface_row_idx)*row_coupling_coefficient* &
1184  & column_coupling_coefficient
1185  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1186  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1187  ENDDO !solution_column_idx
1188  ENDDO !interface_row_idx
1189  ENDDO !solution_row_idx
1190  ENDDO !interface_column_number
1192  CALL flagerror("Not implemented.",err,error,*999)
1194  CALL flagerror("Not implemented.",err,error,*999)
1195  CASE DEFAULT
1196  local_error="The interface matrix storage type of "// &
1197  & trim(number_to_vstring(interface_storage_type,"*",err,error))//" is invalid."
1198  CALL flagerror(local_error,err,error,*999)
1199  END SELECT
1200  CALL distributed_matrix_data_restore(interface_distributed_matrix,interface_matrix_data, &
1201  & err,error,*999)
1202  ELSE
1203  CALL flagerror("The transpose interface matrix distributed matrix is not associated", &
1204  & err,error,*999)
1205  ENDIF
1206  ENDIF
1207  ENDIF !Interface matrix transpose
1208  ELSE
1209  CALL flagerror("The interface matrix distributed matrix is not associated",err,error,*999)
1210  ENDIF
1211  ELSE
1212  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
1213  ENDIF
1214  ELSE
1215  CALL flagerror("Interface to solver map is not associated.",err,error,*999)
1216  ENDIF
1217  ELSE
1218  local_error="The specified interface condition index of "// &
1219  & trim(number_to_vstring(interface_condition_idx,"*",err,error))// &
1220  & " is invalid. The interface condition index needs to be between 1 and "// &
1221  & trim(number_to_vstring(solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS,"*",err,error))//"."
1222  CALL flagerror(local_error,err,error,*999)
1223  ENDIF
1224  ELSE
1225  CALL flagerror("Interface matrices have not been finished.",err,error,*999)
1226  ENDIF
1227  ELSE
1228  CALL flagerror("Interface matrix interface matrices is not associated.",err,error,*999)
1229  ENDIF
1230  ELSE
1231  CALL flagerror("Solver matrices solver mapping is not associated.",err,error,*999)
1232  ENDIF
1233  ELSE
1234  CALL flagerror("Solver matrices have not been finished.",err,error,*999)
1235  ENDIF
1236  ELSE
1237  CALL flagerror("Solver matrix solver matrices is not associated.",err,error,*999)
1238  ENDIF
1239  ENDIF
1240  ELSE
1241  CALL flagerror("Interface matrix is not associated.",err,error,*999)
1242  ENDIF
1243  ELSE
1244  CALL flagerror("Solver matrix is not associated.",err,error,*999)
1245  ENDIF
1246 
1247  exits("SOLVER_MATRIX_INTERFACE_MATRIX_ADD")
1248  RETURN
1249 999 errorsexits("SOLVER_MATRIX_INTERFACE_MATRIX_ADD",err,error)
1250  RETURN 1
1251  END SUBROUTINE solver_matrix_interface_matrix_add
1252 
1253  !
1254  !================================================================================================================================
1255  !
1256 
1258  SUBROUTINE solver_matrix_jacobian_matrix_add(SOLVER_MATRIX,equations_set_idx,ALPHA,JACOBIAN_MATRIX,ERR,ERROR,*)
1260  !Argument variables
1261  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
1262  INTEGER(INTG), INTENT(IN) :: equations_set_idx
1263  REAL(DP), INTENT(IN) :: ALPHA
1264  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
1265  INTEGER(INTG), INTENT(OUT) :: ERR
1266  TYPE(varying_string), INTENT(OUT) :: ERROR
1267  !Local Variables
1268  INTEGER(INTG) :: jacobian_column_idx,jacobian_column_number,jacobian_row_number,JACOBIAN_STORAGE_TYPE, &
1269  & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
1270  INTEGER(INTG), POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
1271  REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
1272  REAL(DP), POINTER :: JACOBIAN_MATRIX_DATA(:)
1273  TYPE(distributed_matrix_type), POINTER :: JACOBIAN_DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
1274  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1275  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
1276  TYPE(jacobian_to_solver_map_type), POINTER :: JACOBIAN_TO_SOLVER_MAP
1277  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1278  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
1279  TYPE(varying_string) :: LOCAL_ERROR
1280 
1281  enters("SOLVER_MATRIX_JACOBIAN_MATRIX_ADD",err,error,*999)
1282 
1283  IF(ASSOCIATED(solver_matrix)) THEN
1284  NULLIFY(solver_matrices)
1285  NULLIFY(solver_mapping)
1286  NULLIFY(nonlinear_matrices)
1287  NULLIFY(equations_matrices)
1288  NULLIFY(jacobian_to_solver_map)
1289  NULLIFY(solver_distributed_matrix)
1290  NULLIFY(jacobian_distributed_matrix)
1291  NULLIFY(jacobian_matrix_data)
1292 
1293  IF(ASSOCIATED(jacobian_matrix)) THEN
1294  IF(abs(alpha)>zero_tolerance) THEN
1295  solver_matrices=>solver_matrix%SOLVER_MATRICES
1296  IF(ASSOCIATED(solver_matrices)) THEN
1297  IF(solver_matrices%SOLVER_MATRICES_FINISHED) THEN
1298  solver_mapping=>solver_matrices%SOLVER_MAPPING
1299  IF(ASSOCIATED(solver_mapping)) THEN
1300  nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1301 
1302  IF(ASSOCIATED(nonlinear_matrices)) THEN
1303  equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1304  IF(ASSOCIATED(equations_matrices)) THEN
1305  IF(equations_matrices%EQUATIONS_MATRICES_FINISHED) THEN
1306  IF(equations_set_idx>0.AND.equations_set_idx<=solver_mapping%NUMBER_OF_EQUATIONS_SETS) THEN
1307  jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1308  & equations_to_solver_matrix_maps_sm(solver_matrix%MATRIX_NUMBER)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1309  & jacobian_matrix%JACOBIAN_NUMBER)%PTR
1310  IF(ASSOCIATED(jacobian_to_solver_map)) THEN
1311  solver_distributed_matrix=>solver_matrix%MATRIX
1312  IF(ASSOCIATED(solver_distributed_matrix)) THEN
1313  jacobian_distributed_matrix=>jacobian_matrix%JACOBIAN
1314  IF(ASSOCIATED(jacobian_distributed_matrix)) THEN
1315  CALL distributed_matrix_storage_type_get(jacobian_distributed_matrix,jacobian_storage_type, &
1316  & err,error,*999)
1317  CALL distributed_matrix_data_get(jacobian_distributed_matrix,jacobian_matrix_data,err,error,*999)
1318 
1319  SELECT CASE(jacobian_storage_type)
1321  !Loop over the rows of the Jacobian matrix
1322  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1323  !Loop over the solution rows this Jacobian row is mapped to
1324  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1325  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1326  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1327  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1328  & solver_rows(solver_row_idx)
1329  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1330  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1331  & coupling_coefficients(solver_row_idx)
1332  !Loop over the columns of the Jacobian matrix
1333  DO jacobian_column_number=1,jacobian_matrix%NUMBER_OF_COLUMNS
1334  !Loop over the solution columns this Jacobian column is mapped to
1335  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1336  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1337  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1338  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1339  column_coupling_coefficient=jacobian_to_solver_map% &
1340  & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1341  & coupling_coefficients(solver_column_idx)
1342  !Add in the solver matrix value
1343  VALUE=alpha*jacobian_matrix_data(jacobian_row_number+(jacobian_column_number-1)* &
1344  & equations_matrices%TOTAL_NUMBER_OF_ROWS)*row_coupling_coefficient* &
1345  & column_coupling_coefficient
1346  CALL distributed_matrix_values_add(solver_distributed_matrix,solver_row_number, &
1347  & solver_column_number,VALUE,err,error,*999)
1348  ENDDO !solver_column_idx
1349  ENDDO !jacobian_column_number
1350  ENDDO !solver_row_idx
1351  ENDDO !jacobian_row_number
1353  !Loop over the rows of the Jacobian matrix
1354  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1355  !Loop over the solution rows this Jacobian row is mapped to
1356  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1357  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1358  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1359  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1360  & solver_rows(solver_row_idx)
1361  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1362  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1363  & coupling_coefficients(solver_row_idx)
1364  jacobian_column_number=jacobian_row_number
1365  !Loop over the solution columns this Jacobian column is mapped to
1366  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1367  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1368  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1369  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1370  column_coupling_coefficient=jacobian_to_solver_map% &
1371  & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1372  & coupling_coefficients(solver_column_idx)
1373  !Add in the solver matrix value
1374  VALUE=alpha*jacobian_matrix_data(jacobian_row_number)* &
1375  & row_coupling_coefficient*column_coupling_coefficient
1376  CALL distributed_matrix_values_add(solver_distributed_matrix, &
1377  & solver_row_number,solver_column_number,VALUE,err,error,*999)
1378  ENDDO !solver_column_idx
1379  ENDDO !solver_row_idx
1380  ENDDO !jacobian_row_number
1382  CALL flagerror("Not implemented.",err,error,*999)
1384  CALL flagerror("Not implemented.",err,error,*999)
1386  CALL distributed_matrix_storage_locations_get(jacobian_distributed_matrix,row_indices, &
1387  & column_indices,err,error,*999)
1388  !Loop over the rows of the Jacobian matrix
1389  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1390  !Loop over the solution rows this Jacobian row is mapped to
1391  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1392  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1393  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1394  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1395  & solver_rows(solver_row_idx)
1396  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1397  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1398  & coupling_coefficients(solver_row_idx)
1399  !Loop over the columns of the Jacobian matrix
1400  DO jacobian_column_idx=row_indices(jacobian_row_number), &
1401  & row_indices(jacobian_row_number+1)-1
1402  jacobian_column_number=column_indices(jacobian_column_idx)
1403  !Loop over the solution columns this equations column is mapped to
1404  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1405  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1406  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1407  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1408  column_coupling_coefficient=jacobian_to_solver_map% &
1409  & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1410  & coupling_coefficients(solver_column_idx)
1411  !Add in the solver matrix value
1412  VALUE=alpha*jacobian_matrix_data(jacobian_column_idx)*row_coupling_coefficient* &
1413  & column_coupling_coefficient
1414  CALL distributed_matrix_values_add(solver_distributed_matrix,solver_row_number, &
1415  & solver_column_number,VALUE,err,error,*999)
1416  ENDDO !solution_column_idx
1417  ENDDO !jacobian_column_idx
1418  ENDDO !solution_row_idx
1419  ENDDO !jacobian_row_number
1421  CALL flagerror("Not implemented.",err,error,*999)
1423  CALL flagerror("Not implemented.",err,error,*999)
1424  CASE DEFAULT
1425  local_error="The Jacobian matrix storage type of "// &
1426  & trim(number_to_vstring(jacobian_storage_type,"*",err,error))//" is invalid."
1427  CALL flagerror(local_error,err,error,*999)
1428  END SELECT
1429  CALL distributed_matrix_data_restore(jacobian_distributed_matrix,jacobian_matrix_data, &
1430  & err,error,*999)
1431  ELSE
1432  CALL flagerror("The Jacobian matrix distributed matrix is not associated",err,error,*999)
1433  ENDIF
1434  ELSE
1435  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
1436  ENDIF
1437  ELSE
1438  CALL flagerror("Jacobian to solver map is not associated.",err,error,*999)
1439  ENDIF
1440  ELSE
1441  local_error="The specified equations set index of "// &
1442  & trim(number_to_vstring(equations_set_idx,"*",err,error))// &
1443  & " is invalid. The equations set index needs to be between 1 and "// &
1444  & trim(number_to_vstring(solver_mapping%NUMBER_OF_EQUATIONS_SETS,"*",err,error))//"."
1445  CALL flagerror(local_error,err,error,*999)
1446  ENDIF
1447  ELSE
1448  CALL flagerror("Equations matrices have not been finished.",err,error,*999)
1449  ENDIF
1450  ELSE
1451  CALL flagerror("Nonlinear matrices equations matrices is not associated.",err,error,*999)
1452  ENDIF
1453  ELSE
1454  CALL flagerror("Jacobian matrix nonlinear matrices is not associated.",err,error,*999)
1455  ENDIF
1456  ELSE
1457  CALL flagerror("Solver matrices solver mapping is not associated.",err,error,*999)
1458  ENDIF
1459  ELSE
1460  CALL flagerror("Solver matrices have not been finished.",err,error,*999)
1461  ENDIF
1462  ELSE
1463  CALL flagerror("Solver matrix solver matrices is not associated.",err,error,*999)
1464  ENDIF
1465  ENDIF
1466  ELSE
1467  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
1468  ENDIF
1469  ELSE
1470  CALL flagerror("Solver matrix is not associated.",err,error,*999)
1471  ENDIF
1472 
1473  exits("SOLVER_MATRIX_JACOBIAN_MATRIX_ADD")
1474  RETURN
1475 999 errorsexits("SOLVER_MATRIX_JACOBIAN_MATRIX_ADD",err,error)
1476  RETURN 1
1477  END SUBROUTINE solver_matrix_jacobian_matrix_add
1478 
1479  !
1480  !================================================================================================================================
1481  !
1482 
1484  SUBROUTINE solver_matrix_structure_calculate(SOLVER_MATRIX,NUMBER_OF_NON_ZEROS,ROW_INDICES,COLUMN_INDICES,ERR,ERROR,*)
1486  !Argument variables
1487  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
1488  INTEGER(INTG), INTENT(OUT) :: NUMBER_OF_NON_ZEROS
1489  INTEGER(INTG), POINTER :: ROW_INDICES(:)
1490  INTEGER(INTG), POINTER :: COLUMN_INDICES(:)
1491  INTEGER(INTG), INTENT(OUT) :: ERR
1492  TYPE(varying_string), INTENT(OUT) :: ERROR
1493  !Local Variables
1494  INTEGER(INTG) :: equations_column_idx,equations_column_number,DUMMY_ERR,equations_matrix_idx,equations_row_number, &
1495  & equations_set_idx,EQUATIONS_STORAGE_TYPE,interface_column_idx,interface_column_number,interface_condition_idx, &
1496  & interface_matrix_idx,interface_row_number,interface_row_idx,INTERFACE_STORAGE_TYPE,jacobian_column_idx, &
1497  & jacobian_column_number,jacobian_row_number,MAX_COLUMN_INDICES,MAX_COLUMNS_PER_ROW,MAX_TRANSPOSE_COLUMNS_PER_ROW, &
1498  & NUMBER_OF_COLUMNS,solver_column_idx,solver_column_number,solver_matrix_idx,solver_row_idx,solver_row_number
1499  INTEGER(INTG), ALLOCATABLE :: COLUMNS(:)
1500  INTEGER(INTG), POINTER :: EQUATIONS_ROW_INDICES(:),EQUATIONS_COLUMN_INDICES(:),INTERFACE_ROW_INDICES(:), &
1501  & INTERFACE_COLUMN_INDICES(:)
1502  REAL(DP) :: SPARSITY
1503  TYPE(distributed_matrix_type), POINTER :: DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
1504  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
1505  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
1506  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1507  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1508  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
1509  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
1510  TYPE(equations_to_solver_maps_type), POINTER :: EQUATIONS_TO_SOLVER_MAP
1511  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
1512  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
1513  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
1514  TYPE(interface_to_solver_maps_type), POINTER :: INTERFACE_TO_SOLVER_MAP
1515  TYPE(jacobian_to_solver_map_type), POINTER :: JACOBIAN_TO_SOLVER_MAP
1516  TYPE(list_ptr_type), ALLOCATABLE :: COLUMN_INDICES_LISTS(:)
1517  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1518  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
1519  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
1520 
1521  enters("SOLVER_MATRIX_STRUCTURE_CALCULATE",err,error,*999)
1522 
1523  number_of_non_zeros=0
1524  IF(ASSOCIATED(solver_matrix)) THEN
1525  IF(.NOT.ASSOCIATED(row_indices)) THEN
1526  IF(.NOT.ASSOCIATED(column_indices)) THEN
1527  solver_distributed_matrix=>solver_matrix%MATRIX
1528  IF(ASSOCIATED(solver_distributed_matrix)) THEN
1529  IF(solver_distributed_matrix%MATRIX_FINISHED) THEN
1530  CALL flagerror("The solver distributed matrix has already been finished.",err,error,*998)
1531  ELSE
1532  solver_matrices=>solver_matrix%SOLVER_MATRICES
1533  IF(ASSOCIATED(solver_matrices)) THEN
1534  solver_mapping=>solver_matrices%SOLVER_MAPPING
1535  IF(ASSOCIATED(solver_mapping)) THEN
1536  SELECT CASE(solver_matrix%STORAGE_TYPE)
1538  CALL flagerror("Can not calcualte the structure for a block storage matrix.",err,error,*999)
1540  CALL flagerror("Can not calcualte the structure for a diagonal matrix.",err,error,*999)
1542  CALL flagerror("Not implemented.",err,error,*999)
1544  CALL flagerror("Not implemented.",err,error,*999)
1546  solver_matrix_idx=solver_matrix%MATRIX_NUMBER
1547  !Find the maximum number of column indices
1548  max_column_indices=0
1549  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1550  IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1551  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES>0) THEN
1552  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1553  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
1554  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1555  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1556  & equations_matrix_idx)%PTR
1557  IF(ASSOCIATED(equations_to_solver_map)) THEN
1558  equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1559  IF(ASSOCIATED(equations_matrix)) THEN
1560  dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
1561  IF(ASSOCIATED(dynamic_matrices)) THEN
1562  equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
1563  IF(ASSOCIATED(equations_matrices)) THEN
1564  distributed_matrix=>equations_matrix%MATRIX
1565  IF(ASSOCIATED(distributed_matrix)) THEN
1566  CALL distributed_matrix_max_columns_per_row_get(distributed_matrix,max_columns_per_row, &
1567  & err,error,*999)
1568  max_column_indices=max_column_indices+max_columns_per_row
1569  ELSE
1570  CALL flagerror("Equations matrix distributed matrix is not associated.",err,error,*999)
1571  ENDIF
1572  ELSE
1573  CALL flagerror("Dynamic matrices equations matrices is not associated.",err,error,*999)
1574  ENDIF
1575  ELSE
1576  CALL flagerror("Equations matrix dynamic matrices is not associated.",err,error,*999)
1577  ENDIF
1578  ELSE
1579  CALL flagerror("Equations matrix is not assocaited.",err,error,*999)
1580  ENDIF
1581  ELSE
1582  CALL flagerror("Equations to solver matrix map is not assocaited.",err,error,*999)
1583  ENDIF
1584  ENDDO !equations_matrix_idx
1585  ELSE
1586  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1587  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1588  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1589  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1590  & equations_matrix_idx)%PTR
1591  IF(ASSOCIATED(equations_to_solver_map)) THEN
1592  equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1593  IF(ASSOCIATED(equations_matrix)) THEN
1594  linear_matrices=>equations_matrix%LINEAR_MATRICES
1595  IF(ASSOCIATED(linear_matrices)) THEN
1596  equations_matrices=>linear_matrices%EQUATIONS_MATRICES
1597  IF(ASSOCIATED(equations_matrices)) THEN
1598  distributed_matrix=>equations_matrix%MATRIX
1599  IF(ASSOCIATED(distributed_matrix)) THEN
1600  CALL distributed_matrix_max_columns_per_row_get(distributed_matrix,max_columns_per_row, &
1601  & err,error,*999)
1602  max_column_indices=max_column_indices+max_columns_per_row
1603  ELSE
1604  CALL flagerror("Equations matrix distributed matrix is not associated.",err,error,*999)
1605  ENDIF
1606  ELSE
1607  CALL flagerror("Linear matrices equations matrices is not associated.",err,error,*999)
1608  ENDIF
1609  ELSE
1610  CALL flagerror("Equations matrix linear matrices is not associated.",err,error,*999)
1611  ENDIF
1612  ELSE
1613  CALL flagerror("Equations matrix is not associated.",err,error,*999)
1614  ENDIF
1615  ELSE
1616  CALL flagerror("Equations to solver matrix map is not associated.",err,error,*999)
1617  ENDIF
1618  ENDDO !equations_matrix_idx
1619  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1620  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
1621  jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1622  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1623  & equations_matrix_idx)%PTR
1624  IF(ASSOCIATED(jacobian_to_solver_map)) THEN
1625  jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
1626  IF(ASSOCIATED(jacobian_matrix)) THEN
1627  nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1628  IF(ASSOCIATED(nonlinear_matrices)) THEN
1629  equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1630  IF(ASSOCIATED(equations_matrices)) THEN
1631  distributed_matrix=>jacobian_matrix%JACOBIAN
1632  IF(ASSOCIATED(distributed_matrix)) THEN
1633  CALL distributed_matrix_max_columns_per_row_get(distributed_matrix,max_columns_per_row, &
1634  & err,error,*999)
1635  max_column_indices=max_column_indices+max_columns_per_row
1636  ELSE
1637  CALL flagerror("Jacobian distributed matrix is not associated.",err,error,*999)
1638  ENDIF
1639  ELSE
1640  CALL flagerror("Nonlinear matrices equations matrices is not associated.",err,error,*999)
1641  ENDIF
1642  ELSE
1643  CALL flagerror("Jacobian matrix nonlinear matrices is not associated.",err,error,*999)
1644  ENDIF
1645  ELSE
1646  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
1647  ENDIF
1648  ENDIF
1649  ENDDO !equations_matrix_idx
1650  ENDIF
1651  ENDDO !equations_set_idx
1652  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
1653  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
1654  SELECT CASE(interface_condition%METHOD)
1656  DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1657  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
1658  interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1659  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1660  & interface_matrix_idx)%PTR
1661  IF(ASSOCIATED(interface_to_solver_map)) THEN
1662  interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
1663  IF(ASSOCIATED(interface_matrix)) THEN
1664  interface_matrices=>interface_matrix%INTERFACE_MATRICES
1665  IF(ASSOCIATED(interface_matrices)) THEN
1666  distributed_matrix=>interface_matrix%MATRIX
1667  IF(ASSOCIATED(distributed_matrix)) THEN
1668  CALL distributed_matrix_max_columns_per_row_get(distributed_matrix,max_columns_per_row, &
1669  & err,error,*999)
1670  ELSE
1671  CALL flagerror("Interface matrix distributed matrix is not associated.",err,error,*999)
1672  ENDIF
1673  ELSE
1674  CALL flagerror("Interface matrix interface matrices is not associated.",err,error,*999)
1675  ENDIF
1676  max_transpose_columns_per_row=0
1677  IF(interface_matrix%HAS_TRANSPOSE) THEN
1678  distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
1679  IF(ASSOCIATED(distributed_matrix)) THEN
1680  CALL distributed_matrix_max_columns_per_row_get(distributed_matrix, &
1681  & max_transpose_columns_per_row,err,error,*999)
1682  ELSE
1683  CALL flagerror("Interface matrix distributed matrix transpose is not associated.",err,error,*999)
1684  ENDIF
1685  ENDIF
1686  max_column_indices=max_column_indices+max(max_columns_per_row,max_transpose_columns_per_row)
1687  ELSE
1688  CALL flagerror("Interface to solver map interface matrix is not associated.",err,error,*999)
1689  ENDIF
1690  ELSE
1691  CALL flagerror("Interface to solver matrix map is not associated.",err,error,*999)
1692  ENDIF
1693  ENDDO !interface_matrix_idx
1695  CALL flagerror("Not implemented.",err,error,*999)
1697  CALL flagerror("Not implemented.",err,error,*999)
1698  CASE DEFAULT
1699  local_error="The interface condition method of "// &
1700  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))// &
1701  & " is invalid."
1702  CALL flagerror(local_error,err,error,*999)
1703  END SELECT
1704  ENDDO !interface_condition_idx
1705  !Allocate lists
1706  ALLOCATE(column_indices_lists(solver_mapping%NUMBER_OF_ROWS),stat=err)
1707  IF(err/=0) CALL flagerror("Could not allocate column indices lists.",err,error,*999)
1708  !Allocate row indices
1709  ALLOCATE(row_indices(solver_mapping%NUMBER_OF_ROWS+1),stat=err)
1710  IF(err/=0) CALL flagerror("Could not allocate row indices.",err,error,*999)
1711  row_indices(1)=1
1712  !Set up the column indicies lists
1713  DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
1714  NULLIFY(column_indices_lists(solver_row_number)%PTR)
1715  CALL list_create_start(column_indices_lists(solver_row_number)%PTR,err,error,*999)
1716  CALL list_data_type_set(column_indices_lists(solver_row_number)%PTR,list_intg_type,err,error,*999)
1717  CALL list_initial_size_set(column_indices_lists(solver_row_number)%PTR,max_column_indices,err,error,*999)
1718  CALL list_create_finish(column_indices_lists(solver_row_number)%PTR,err,error,*999)
1719  ENDDO !solver_row_number
1720  !Loop over the equations sets
1721  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1722  IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1723  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES>0) THEN
1724  !Loop over the dynamic equations matrices mapped to the solver matrix and calculate the col indices by row.
1725  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1726  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
1727  !Note: pointers have been checked above
1728  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1729  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1730  & equations_matrix_idx)%PTR
1731  equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1732  dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
1733  equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
1734  distributed_matrix=>equations_matrix%MATRIX
1735  CALL distributed_matrix_storage_type_get(distributed_matrix,equations_storage_type,err,error,*999)
1736  SELECT CASE(equations_storage_type)
1738  !Loop over the rows of the equations matrix
1739  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1740  !Loop over the solver rows this equations row is mapped to
1741  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1742  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1743  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1744  & equations_row_to_solver_rows_maps(equations_row_number)% &
1745  & solver_rows(solver_row_idx)
1746  !Loop over the columns of the equations matrix
1747  DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
1748  !Loop over the solver columns this equations column is mapped to
1749  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1750  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1751  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1752  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1753  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1754  & err,error,*999)
1755  ENDDO !solver_column_idx
1756  ENDDO !equations_column_number
1757  ENDDO !solver_row_idx
1758  ENDDO !equations_row_number
1760  !Loop over the rows of the equations matrix
1761  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1762  !Loop over the solver rows this equations row is mapped to
1763  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1764  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1765  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1766  & equations_row_to_solver_rows_maps(equations_row_number)% &
1767  & solver_rows(solver_row_idx)
1768  equations_column_number=equations_row_number
1769  !Loop over the solver columns this equations column is mapped to
1770  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1771  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1772  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1773  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1774  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1775  & err,error,*999)
1776  ENDDO !solver_column_idx
1777  ENDDO !solver_row_idx
1778  ENDDO !equations_row_number
1780  CALL flagerror("Not implemented.",err,error,*999)
1782  CALL flagerror("Not implemented.",err,error,*999)
1784  CALL distributed_matrix_storage_locations_get(distributed_matrix,equations_row_indices, &
1785  & equations_column_indices,err,error,*999)
1786  !Loop over the rows of the equations matrix
1787  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1788  !Loop over the solver rows this equations row is mapped to
1789  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1790  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1791  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1792  & equations_row_to_solver_rows_maps(equations_row_number)% &
1793  & solver_rows(solver_row_idx)
1794  !Loop over the columns of the equations matrix
1795  DO equations_column_idx=equations_row_indices(equations_row_number), &
1796  & equations_row_indices(equations_row_number+1)-1
1797  equations_column_number=equations_column_indices(equations_column_idx)
1798  !Loop over the solver columns this equations column is mapped to
1799  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1800  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1801  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1802  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1803  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1804  & err,error,*999)
1805  ENDDO !solver_column_idx
1806  ENDDO !equations_column_idx
1807  ENDDO !equations_row_idx
1808  ENDDO !equations_row_number
1810  CALL flagerror("Not implemented.",err,error,*999)
1812  CALL flagerror("Not implemented.",err,error,*999)
1813  CASE DEFAULT
1814  local_error="The matrix storage type of "// &
1815  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
1816  CALL flagerror(local_error,err,error,*999)
1817  END SELECT
1818  ENDDO !equations_matrix_idx
1819  ELSE
1820  !Loop over the linear equations matrices mapped to the solver matrix and calculate the col indices by row.
1821  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1822  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1823  !Note: pointers have been checked above
1824  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1825  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1826  & equations_matrix_idx)%PTR
1827  equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1828  linear_matrices=>equations_matrix%LINEAR_MATRICES
1829  equations_matrices=>linear_matrices%EQUATIONS_MATRICES
1830  distributed_matrix=>equations_matrix%MATRIX
1831  CALL distributed_matrix_storage_type_get(distributed_matrix,equations_storage_type,err,error,*999)
1832  SELECT CASE(equations_storage_type)
1834  !Loop over the rows of the equations matrix
1835  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1836  !Loop over the solver rows this equations row is mapped to
1837  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1838  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1839  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1840  & equations_row_to_solver_rows_maps(equations_row_number)% &
1841  & solver_rows(solver_row_idx)
1842  !Loop over the columns of the equations matrix
1843  DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
1844  !Loop over the solver columns this equations column is mapped to
1845  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1846  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1847  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1848  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1849  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1850  & err,error,*999)
1851  ENDDO !solver_column_idx
1852  ENDDO !equations_column_number
1853  ENDDO !solver_row_idx
1854  ENDDO !equations_row_number
1856  !Loop over the rows of the equations matrix
1857  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1858  !Loop over the solver rows this equations row is mapped to
1859  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1860  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1861  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1862  & equations_row_to_solver_rows_maps(equations_row_number)% &
1863  & solver_rows(solver_row_idx)
1864  equations_column_number=equations_row_number
1865  !Loop over the solver columns this equations column is mapped to
1866  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1867  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1868  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1869  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1870  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1871  & err,error,*999)
1872  ENDDO !solver_column_idx
1873  ENDDO !solver_row_idx
1874  ENDDO !equations_row_number
1876  CALL flagerror("Not implemented.",err,error,*999)
1878  CALL flagerror("Not implemented.",err,error,*999)
1880  CALL distributed_matrix_storage_locations_get(distributed_matrix,equations_row_indices, &
1881  & equations_column_indices,err,error,*999)
1882  !Loop over the rows of the equations matrix
1883  DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1884  !Loop over the solver rows this equations row is mapped to
1885  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1886  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1887  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1888  & equations_row_to_solver_rows_maps(equations_row_number)% &
1889  & solver_rows(solver_row_idx)
1890  !Loop over the columns of the equations matrix
1891  DO equations_column_idx=equations_row_indices(equations_row_number), &
1892  & equations_row_indices(equations_row_number+1)-1
1893  equations_column_number=equations_column_indices(equations_column_idx)
1894  !Loop over the solver columns this equations column is mapped to
1895  DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1896  & equations_column_number)%NUMBER_OF_SOLVER_COLS
1897  solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1898  & equations_column_number)%SOLVER_COLS(solver_column_idx)
1899  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1900  & err,error,*999)
1901  ENDDO !solver_column_idx
1902  ENDDO !equations_column_idx
1903  ENDDO !equations_row_idx
1904  ENDDO !equations_row_number
1906  CALL flagerror("Not implemented.",err,error,*999)
1908  CALL flagerror("Not implemented.",err,error,*999)
1909  CASE DEFAULT
1910  local_error="The matrix storage type of "// &
1911  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
1912  CALL flagerror(local_error,err,error,*999)
1913  END SELECT
1914  ENDDO !equations_matrix_idx
1915  !Now add any columns from the Jacobians
1916  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1917  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
1918  jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1919  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1920  & equations_matrix_idx)%PTR
1921  IF(ASSOCIATED(jacobian_to_solver_map)) THEN
1922  !Note: pointers have been checked above
1923  jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
1924  nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1925  equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1926  distributed_matrix=>jacobian_matrix%JACOBIAN
1927  CALL distributed_matrix_storage_type_get(distributed_matrix,equations_storage_type,err,error,*999)
1928  SELECT CASE(equations_storage_type)
1930  !Loop over the rows of the Jacobian matrix
1931  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1932  !Loop over the solver rows this equations row is mapped to
1933  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1934  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1935  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1936  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1937  & solver_rows(solver_row_idx)
1938  !Loop over the columns of the Jacobian
1939  DO jacobian_column_number=1,jacobian_matrix%NUMBER_OF_COLUMNS
1940  !Loop over the solver columns this equations column is mapped to
1941  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1942  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1943  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1944  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1945  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1946  & err,error,*999)
1947  ENDDO !solver_column_idx
1948  ENDDO !jacobian_column_number
1949  ENDDO !solver_row_idx
1950  ENDDO !jacobian_row_number
1952  !Loop over the rows of the Jacobian matrix
1953  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1954  !Loop over the solver rows this equations row is mapped to
1955  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1956  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1957  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1958  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1959  & solver_rows(solver_row_idx)
1960  jacobian_column_number=jacobian_row_number
1961  !Loop over the solver columns this equations column is mapped to
1962  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1963  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1964  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1965  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1966  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1967  & err,error,*999)
1968  ENDDO !solver_column_idx
1969  ENDDO !solver_row_idx
1970  ENDDO !jacobian_row_number
1972  CALL flagerror("Not implemented.",err,error,*999)
1974  CALL flagerror("Not implemented.",err,error,*999)
1976  CALL distributed_matrix_storage_locations_get(distributed_matrix,equations_row_indices, &
1977  & equations_column_indices,err,error,*999)
1978  !Loop over the rows of the Jacobian matrix
1979  DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1980  !Loop over the solver rows this equations row is mapped to
1981  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1982  & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1983  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1984  & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1985  & solver_rows(solver_row_idx)
1986  !Loop over the columns of the Jacobian matrix
1987  DO jacobian_column_idx=equations_row_indices(jacobian_row_number), &
1988  & equations_row_indices(jacobian_row_number+1)-1
1989  jacobian_column_number=equations_column_indices(jacobian_column_idx)
1990  !Loop over the solver columns this Jacobian column is mapped to
1991  DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1992  & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1993  solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1994  & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1995  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1996  & err,error,*999)
1997  ENDDO !solver_column_idx
1998  ENDDO !jacobian_column_idx
1999  ENDDO !solver_row_idx
2000  ENDDO !jacobian_row_number
2002  CALL flagerror("Not implemented.",err,error,*999)
2004  CALL flagerror("Not implemented.",err,error,*999)
2005  CASE DEFAULT
2006  local_error="The Jacobian storage type of "// &
2007  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
2008  CALL flagerror(local_error,err,error,*999)
2009  END SELECT
2010  ENDIF
2011  ENDDO !equations_matrix_idx
2012  ENDIF
2013  !Now add in any interface matrices columns
2014  DO interface_condition_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
2015  & number_of_interface_conditions
2016  ENDDO !interface_condition_idx
2017  ENDDO !equations_set_idx
2018  !Loop over any equations sets
2019  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
2020  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
2021  SELECT CASE(interface_condition%METHOD)
2023  DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2024  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
2025  interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2026  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
2027  & interface_matrix_idx)%PTR
2028  interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
2029  interface_matrices=>interface_matrix%INTERFACE_MATRICES
2030  distributed_matrix=>interface_matrix%MATRIX
2031  CALL distributed_matrix_storage_type_get(distributed_matrix,interface_storage_type,err,error,*999)
2032  SELECT CASE(interface_storage_type)
2034  !Loop over the rows of the interface matrix
2035  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2036  !Loop over the solver rows this interface column is mapped to
2037  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2038  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2039  interface_row_number)%NUMBER_OF_SOLVER_ROWS
2040  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2041  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2042  & interface_row_number)%SOLVER_ROW
2043  !Loop over the columns of the interface matrix
2044  DO interface_column_number=1,interface_matrices%TOTAL_NUMBER_OF_COLUMNS
2045  !Loop over the solver columns this interface column is mapped to
2046  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2047  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2048  & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2049  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2050  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2051  & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2052  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2053  & err,error,*999)
2054  ENDDO !solver_column_idx
2055  ENDDO !interface_column_number
2056  ENDDO !solver_row_idx
2057  ENDDO !interface_row_number
2059  !Loop over the rows of the interface matrix
2060  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2061  !Loop over the solver rows this interface column is mapped to
2062  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2063  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2064  interface_row_number)%NUMBER_OF_SOLVER_ROWS
2065  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2066  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2067  & interface_row_number)%SOLVER_ROW
2068  interface_column_number=interface_row_number
2069  !Loop over the solver columns this interface column is mapped to
2070  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2071  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2072  & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2073  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2074  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2075  & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2076  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2077  & err,error,*999)
2078  ENDDO !solver_column_idx
2079  ENDDO !solver_row_idx
2080  ENDDO !interface_row_number
2082  CALL flagerror("Not implemented.",err,error,*999)
2084  CALL flagerror("Not implemented.",err,error,*999)
2086  CALL distributed_matrix_storage_locations_get(distributed_matrix,interface_row_indices, &
2087  & interface_column_indices,err,error,*999)
2088  !Loop over the rows of the interface matrix
2089  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2090  !Loop over the solver rows this interface column is mapped to
2091  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2092  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2093  interface_row_number)%NUMBER_OF_SOLVER_ROWS
2094  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2095  & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2096  & interface_row_number)%SOLVER_ROW
2097  !Loop over the columns of the interface matrix
2098  DO interface_column_idx=interface_row_indices(interface_row_number), &
2099  & interface_row_indices(interface_row_number+1)-1
2100  interface_column_number=interface_column_indices(interface_column_idx)
2101  !Loop over the solver columns this interface column is mapped to
2102  DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2103  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2104  & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2105  solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2106  & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2107  & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2108  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2109  & err,error,*999)
2110  ENDDO !solver_column_idx
2111  ENDDO !interface_column_idx
2112  ENDDO !solver_row_idx
2113  ENDDO !interface_row_number
2115  CALL flagerror("Not implemented.",err,error,*999)
2117  CALL flagerror("Not implemented.",err,error,*999)
2118  CASE DEFAULT
2119  local_error="The matrix storage type of "// &
2120  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
2121  CALL flagerror(local_error,err,error,*999)
2122  END SELECT
2123  IF(interface_matrix%HAS_TRANSPOSE) THEN
2124  distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
2125  !Loop over the rows of the transposed interface matrix
2126  CALL distributed_matrix_storage_type_get(distributed_matrix,interface_storage_type,err,error,*999)
2127  SELECT CASE(interface_storage_type)
2129  !Loop over the columns of the interface matrix
2130  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2131  !Loop over the solver rows this interface column is mapped to
2132  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2133  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2134  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2135  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2136  !Loop over the rows of the interface matrix
2137  DO interface_row_number=1,interface_matrix%TOTAL_NUMBER_OF_ROWS
2138  !Loop over the solver columns this interface row is mapped to
2139  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2140  & interface_row_number)%NUMBER_OF_SOLVER_COLS
2141  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2142  & interface_row_number)%SOLVER_COLS(solver_column_idx)
2143  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2144  & err,error,*999)
2145  ENDDO !solver_column_idx
2146  ENDDO !interface_row_number
2147  ENDDO !solver_row_idx
2148  ENDDO !interface_column_number
2150  !Loop over the columns of the interface matrix
2151  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2152  !Loop over the solver rows this interface column is mapped to
2153  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2154  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2155  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2156  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2157  interface_row_number=interface_column_number
2158  !Loop over the solver columns this interface row is mapped to
2159  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2160  & interface_row_number)%NUMBER_OF_SOLVER_COLS
2161  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2162  & interface_row_number)%SOLVER_COLS(solver_column_idx)
2163  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2164  & err,error,*999)
2165  ENDDO !solver_column_idx
2166  ENDDO !solver_row_idx
2167  ENDDO !interface_column_number
2169  CALL flagerror("Not implemented.",err,error,*999)
2171  CALL flagerror("Not implemented.",err,error,*999)
2173  CALL distributed_matrix_storage_locations_get(distributed_matrix,interface_row_indices, &
2174  & interface_column_indices,err,error,*999)
2175  !Loop over the columns of the interface matrix
2176  DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2177  !Loop over the solver rows this interface column is mapped to
2178  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2179  & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2180  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2181  & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2182  !Loop over the rows of the interface matrix
2183  DO interface_row_idx=interface_row_indices(interface_column_number), &
2184  & interface_row_indices(interface_column_number+1)-1
2185  interface_row_number=interface_column_indices(interface_row_idx)
2186  !Loop over the solver columns this interface row is mapped to
2187  DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2188  & interface_row_number)%NUMBER_OF_SOLVER_COLS
2189  solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2190  & interface_row_number)%SOLVER_COLS(solver_column_idx)
2191  CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2192  & err,error,*999)
2193  ENDDO !solver_column_idx
2194  ENDDO !interface_row_idx
2195  ENDDO !solver_row_idx
2196  ENDDO !interface_col_number
2198  CALL flagerror("Not implemented.",err,error,*999)
2200  CALL flagerror("Not implemented.",err,error,*999)
2201  CASE DEFAULT
2202  local_error="The matrix storage type of "// &
2203  & trim(number_to_vstring(equations_storage_type,"*",err,error))//" is invalid."
2204  CALL flagerror(local_error,err,error,*999)
2205  END SELECT
2206  ENDIF
2207  ENDDO !interface_matrix_idx
2209  CALL flagerror("Not implemented.",err,error,*999)
2211  CALL flagerror("Not implemented.",err,error,*999)
2212  CASE DEFAULT
2213  local_error="The interface condition method of "// &
2214  & trim(number_to_vstring(interface_condition%METHOD,"*",err,error))// &
2215  & " is invalid."
2216  CALL flagerror(local_error,err,error,*999)
2217  END SELECT
2218  ENDDO !interface_condition_idx
2219  !Loop over the rows to calculate the number of non-zeros and setup the row indicces
2220  DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2221  CALL list_remove_duplicates(column_indices_lists(solver_row_number)%PTR,err,error,*999)
2222  CALL list_number_of_items_get(column_indices_lists(solver_row_number)%PTR,number_of_columns,err,error,*999)
2223  number_of_non_zeros=number_of_non_zeros+number_of_columns
2224  row_indices(solver_row_number+1)=number_of_non_zeros+1
2225  ENDDO !solver_row_number
2226  !Allocate and setup the column locations
2227  ALLOCATE(column_indices(number_of_non_zeros),stat=err)
2228  IF(err/=0) CALL flagerror("Could not allocate column indices.",err,error,*999)
2229  DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2230  CALL list_detach_and_destroy(column_indices_lists(solver_row_number)%PTR,number_of_columns,columns, &
2231  & err,error,*999)
2232  DO solver_column_idx=1,number_of_columns
2233  column_indices(row_indices(solver_row_number)+solver_column_idx-1)=columns(solver_column_idx)
2234  ENDDO !solver_column_idx
2235  DEALLOCATE(columns)
2236  ENDDO !solver_row_idx
2238  CALL flagerror("Not implemented.",err,error,*999)
2240  CALL flagerror("Not implemented.",err,error,*999)
2241  CASE DEFAULT
2242  local_error="The matrix storage type of "// &
2243  & trim(number_to_vstring(solver_matrix%STORAGE_TYPE,"*",err,error))//" is invalid."
2244  CALL flagerror(local_error,err,error,*999)
2245  END SELECT
2246 
2247  IF(diagnostics1) THEN
2248  CALL write_string(diagnostic_output_type,"Solver matrix structure:",err,error,*999)
2249  CALL write_string_value(diagnostic_output_type,"Solver matrix number : ",solver_matrix%MATRIX_NUMBER, &
2250  & err,error,*999)
2251  CALL write_string_value(diagnostic_output_type," Number of rows = ",solver_matrices%NUMBER_OF_ROWS, &
2252  & err,error,*999)
2253  CALL write_string_value(diagnostic_output_type," Number of columns = ",solver_matrix%NUMBER_OF_COLUMNS, &
2254  & err,error,*999)
2255  CALL write_string_value(diagnostic_output_type," Number of non zeros = ",number_of_non_zeros,err,error,*999)
2256  IF(solver_matrices%NUMBER_OF_ROWS*solver_matrix%NUMBER_OF_COLUMNS/=0) THEN
2257  sparsity=REAL(number_of_non_zeros,dp)/REAL(solver_matrices%number_of_rows* &
2258  & SOLVER_MATRIX%NUMBER_OF_COLUMNS,DP)*100.0_DP
2259  CALL WRITE_STRING_FMT_VALUE(diagnostic_output_type," Sparsity (%) = ",sparsity,"F6.2", err,error,*999)
2260  ENDIF
2261  IF(diagnostics2) THEN
2262  CALL write_string_vector(diagnostic_output_type,1,1,solver_matrices%NUMBER_OF_ROWS+1,8,8,row_indices, &
2263  & '(" Row indices :",8(X,I13))','(18X,8(X,I13))',err,error,*999)
2264  CALL write_string_vector(diagnostic_output_type,1,1,number_of_non_zeros,8,8,column_indices, &
2265  & '(" Column indices :",8(X,I13))','(18X,8(X,I13))', err,error,*999)
2266  ENDIF
2267  ENDIF
2268  ELSE
2269  CALL flagerror("Solver matrices solver mapping is not associated",err,error,*999)
2270  ENDIF
2271  ELSE
2272  CALL flagerror("Solver matrix solver matrices is not associated",err,error,*999)
2273  ENDIF
2274  ENDIF
2275  ELSE
2276  CALL flagerror("Solver matrix distributed matrix is not associated",err,error,*999)
2277  ENDIF
2278  ELSE
2279  CALL flagerror("Column indices is already associated",err,error,*998)
2280  ENDIF
2281  ELSE
2282  CALL flagerror("Row indices is already associated",err,error,*998)
2283  ENDIF
2284  ELSE
2285  CALL flagerror("Solver matrix is not associated.",err,error,*999)
2286  ENDIF
2287 
2288  exits("SOLVER_MATRIX_STRUCTURE_CALCULATE")
2289  RETURN
2290 999 IF(ASSOCIATED(row_indices)) DEALLOCATE(row_indices)
2291  IF(ASSOCIATED(column_indices)) DEALLOCATE(column_indices)
2292  IF(ALLOCATED(columns)) DEALLOCATE(columns)
2293  IF(ALLOCATED(column_indices_lists)) THEN
2294  DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2295  IF(ASSOCIATED(column_indices_lists(solver_row_number)%PTR)) &
2296  & CALL list_destroy(column_indices_lists(solver_row_number)%PTR,dummy_err,dummy_error,*998)
2297  ENDDO !solver_row_number
2298  DEALLOCATE(column_indices_lists)
2299  ENDIF
2300 998 errorsexits("SOLVER_MATRIX_STRUCTURE_CALCULATE",err,error)
2301  RETURN 1
2302 
2303  END SUBROUTINE solver_matrix_structure_calculate
2304 
2305  !
2306  !================================================================================================================================
2307  !
2308 
2310  SUBROUTINE solver_matrix_finalise(SOLVER_MATRIX,ERR,ERROR,*)
2312  !Argument variables
2313  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
2314  INTEGER(INTG), INTENT(OUT) :: ERR
2315  TYPE(varying_string), INTENT(OUT) :: ERROR
2316  !Local Variables
2317 
2318  enters("SOLVER_MATRIX_FINALISE",err,error,*999)
2319 
2320  IF(ASSOCIATED(solver_matrix)) THEN
2321  IF(ASSOCIATED(solver_matrix%MATRIX)) CALL distributed_matrix_destroy(solver_matrix%MATRIX,err,error,*999)
2322  IF(ASSOCIATED(solver_matrix%SOLVER_VECTOR)) CALL distributed_vector_destroy(solver_matrix%SOLVER_VECTOR,err,error,*999)
2323  DEALLOCATE(solver_matrix)
2324  ENDIF
2325 
2326  exits("SOLVER_MATRIX_FINALISE")
2327  RETURN
2328 999 errorsexits("SOLVER_MATRIX_FINALISE",err,error)
2329  RETURN 1
2330 
2331  END SUBROUTINE solver_matrix_finalise
2332 
2333  !
2334  !================================================================================================================================
2335  !
2336 
2338  SUBROUTINE solver_matrix_form(SOLVER_MATRIX,ERR,ERROR,*)
2340  !Argument variables
2341  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
2342  INTEGER(INTG), INTENT(OUT) :: ERR
2343  TYPE(varying_string), INTENT(OUT) :: ERROR
2344  !Local Variables
2345 
2346  enters("SOLVER_MATRIX_FORM",err,error,*999)
2347 
2348  IF(ASSOCIATED(solver_matrix)) THEN
2349  CALL distributed_matrix_form(solver_matrix%MATRIX,err,error,*999)
2350  ELSE
2351  CALL flagerror("Solver matrix is not associated.",err,error,*999)
2352  ENDIF
2353 
2354  exits("SOLVER_MATRIX_FORM")
2355  RETURN
2356 999 errorsexits("SOLVER_MATRIX_FORM",err,error)
2357  RETURN 1
2358 
2359  END SUBROUTINE solver_matrix_form
2360 
2361  !
2362  !================================================================================================================================
2363  !
2364 
2366  SUBROUTINE solver_matrix_initialise(SOLVER_MATRICES,MATRIX_NUMBER,ERR,ERROR,*)
2368  !Argument variables
2369  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
2370  INTEGER(INTG), INTENT(IN) :: MATRIX_NUMBER
2371  INTEGER(INTG), INTENT(OUT) :: ERR
2372  TYPE(varying_string), INTENT(OUT) :: ERROR
2373  !Local Variables
2374  INTEGER(INTG) :: DUMMY_ERR
2375  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
2376  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
2377  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
2378 
2379  enters("SOLVER_MATRIX_INITIALISE",err,error,*998)
2380 
2381  IF(ASSOCIATED(solver_matrices)) THEN
2382  IF(matrix_number>0.AND.matrix_number<=solver_matrices%NUMBER_OF_MATRICES) THEN
2383  solver_mapping=>solver_matrices%SOLVER_MAPPING
2384  IF(ASSOCIATED(solver_mapping)) THEN
2385  IF(ASSOCIATED(solver_matrices%MATRICES(matrix_number)%PTR)) THEN
2386  CALL flagerror("Solver matrix is already associated.",err,error,*998)
2387  ELSE
2388  ALLOCATE(solver_matrices%MATRICES(matrix_number)%PTR,stat=err)
2389  IF(err/=0) CALL flagerror("Could not allocate solver matrix.",err,error,*999)
2390  solver_matrix=>solver_matrices%MATRICES(matrix_number)%PTR
2391  solver_matrix%MATRIX_NUMBER=matrix_number
2392  solver_matrix%SOLVER_MATRICES=>solver_matrices
2393  solver_matrix%STORAGE_TYPE=matrix_block_storage_type
2394  solver_matrix%UPDATE_MATRIX=.true.
2395  solver_matrix%NUMBER_OF_COLUMNS=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_number)%NUMBER_OF_COLUMNS
2396  solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_number)%SOLVER_MATRIX=>solver_matrix
2397  NULLIFY(solver_matrix%SOLVER_VECTOR)
2398  NULLIFY(solver_matrix%MATRIX)
2399  ENDIF
2400  ELSE
2401  CALL flagerror("Solver mapping is not associated.",err,error,*998)
2402  ENDIF
2403  ELSE
2404  local_error="The specified matrix number of "//trim(number_to_vstring(matrix_number,"*",err,error))// &
2405  & " is invalid. The number must be > 0 and <= "// &
2406  & trim(number_to_vstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))//"."
2407  CALL flagerror(local_error,err,error,*998)
2408  ENDIF
2409  ELSE
2410  CALL flagerror("Solver matrices is not associated.",err,error,*998)
2411  ENDIF
2412 
2413  exits("SOLVER_MATRIX_INITIALISE")
2414  RETURN
2415 999 CALL solver_matrix_finalise(solver_matrices%MATRICES(matrix_number)%PTR,dummy_err,dummy_error,*998)
2416 998 errorsexits("SOLVER_MATRIX_INITIALISE",err,error)
2417  RETURN 1
2418 
2419  END SUBROUTINE solver_matrix_initialise
2420 
2421  !
2422  !================================================================================================================================
2423  !
2424 
2425 END MODULE solver_matrices_routines
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public distributed_matrix_create_finish(DISTRIBUTED_MATRIX, ERR, ERROR,)
Finishes the creation of a distributed matrix.
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
subroutine, public distributed_matrix_library_type_set(DISTRIBUTED_MATRIX, LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the library type for a distributed matrix.
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
subroutine solver_matrix_form(SOLVER_MATRIX, ERR, ERROR,)
Forms a solver matrix by initialising the structure of the matrix to zero.
integer(intg), parameter, public matrix_vector_dp_type
Double precision real matrix-vector data type.
This module handles all solver matrix and rhs routines.
subroutine, public solver_matrix_jacobian_matrix_add(SOLVER_MATRIX, equations_set_idx, ALPHA, JACOBIAN_MATRIX, ERR, ERROR,)
Adds alpha times the Jacobian matrix into the solver matrix.
This module handles all problem wide constants.
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public distributed_vector_create_start(DOMAIN_MAPPING, DISTRIBUTED_VECTOR, ERR, ERROR,)
Starts the creation a distributed vector.
subroutine, public distributed_vector_create_finish(DISTRIBUTED_VECTOR, ERR, ERROR,)
Finishes the creation a distributed vector.
subroutine, public distributed_matrix_data_type_set(DISTRIBUTED_MATRIX, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed matrix.
Contains information about an interface matrix.
Definition: types.f90:1978
integer(intg), parameter, public distributed_matrix_row_major_storage_type
Distributed matrix row major storage type.
subroutine, public solver_matrices_create_finish(SOLVER_MATRICES, ERR, ERROR,)
Finishes the process of creating the solver matrices.
subroutine, public distributed_matrix_create_start(ROW_DOMAIN_MAPPING, COLUMN_DOMAIN_MAPPING, DISTRIBUTED_MATRIX, ERR, ERROR,)
Starts the creation of a distributed matrix.
integer(intg), parameter, public matrix_compressed_column_storage_type
Matrix compressed column storage type.
integer(intg), parameter interface_condition_lagrange_multipliers_method
Lagrange multipliers interface condition method.
integer(intg), parameter, public distributed_matrix_vector_cmiss_type
CMISS distributed matrix-vector library type.
subroutine, public distributed_matrix_storage_type_set(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Sets/changes the storage type of a distributed matrix.
integer(intg), parameter, public solver_matrices_residual_only
Select only the residual solver vector.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
Contains information for the interface condition data.
Definition: types.f90:2155
subroutine, public distributed_matrix_form(DISTRIBUTED_MATRIX, ERR, ERROR,)
Forms a distributed matrix by initialising the structure of the matrix to zero.
integer(intg), parameter, public solver_matrices_rhs_residual_only
Select only the residual and RHS solver vectors.
logical, save, public diagnostics2
.TRUE. if level 2 diagnostic output is active in the current routine
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
integer(intg), parameter, public solver_matrices_rhs_only
Select only the RHS solver vector.
integer(intg), parameter interface_condition_augmented_lagrange_method
Augmented Lagrange multiplers interface condition method.
subroutine, public solver_matrices_create_start(SOLVER_EQUATIONS, SOLVER_MATRICES, ERR, ERROR,)
Starts the process of creating the solver matrices.
integer(intg), parameter, public matrix_row_major_storage_type
Matrix row major storage type.
integer(intg), parameter, public distributed_matrix_column_major_storage_type
Distributed matrix column major storage type.
subroutine, public solver_matrices_storage_type_set(SOLVER_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the solver matrices.
subroutine, public solver_matrix_equations_matrix_add(SOLVER_MATRIX, equations_set_idx, ALPHA, EQUATIONS_MATRIX, ERR, ERROR,)
Adds alpha times the equations matrix into the solver matrix.
subroutine, public distributed_matrix_max_columns_per_row_get(DISTRIBUTED_MATRIX, MAX_COLUMNS_PER_ROW, ERR, ERROR,)
Gets the maximum number of columns in each row of a distributed matrix.
subroutine solver_matrix_structure_calculate(SOLVER_MATRIX, NUMBER_OF_NON_ZEROS, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Calculates the structure (sparsity) of the solver matrix from the soluton mapping.
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...
integer, parameter dp
Double precision real kind.
Definition: kinds.f90:68
subroutine, public exits(NAME)
Records the exit out of the named procedure.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
subroutine solver_matrices_storage_type_get(SOLVER_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Gets the storage type (sparsity) of the solver matrices.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter, public solver_matrices_linear_only
Select only the linear solver matrices and vectors.
subroutine solver_matrices_initialise(SOLVER_EQUATIONS, ERR, ERROR,)
Initialises the solver matrices for solver equations.
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
subroutine, public distributed_matrix_destroy(DISTRIBUTED_MATRIX, ERR, ERROR,)
Destroys a distributed matrix.
Contains information on the solver matrix.
Definition: types.f90:2411
integer(intg), parameter interface_condition_penalty_method
Penalty interface condition method.
subroutine solver_matrices_library_type_get(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Gets the library type for the solver matrices (and vectors)
Contains information about the solver equations for a solver.
Definition: types.f90:2452
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
subroutine solver_matrix_initialise(SOLVER_MATRICES, MATRIX_NUMBER, ERR, ERROR,)
Initialises a solver matrix.
subroutine, public distributed_matrix_storage_type_get(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Gets the storage type of a distributed matrix.
subroutine, public distributed_vector_output(ID, DISTRIBUTED_VECTOR, ERR, ERROR,)
Outputs a distributed vector to the specified output ID.
integer(intg), parameter, public matrix_diagonal_storage_type
Matrix diagonal storage type.
subroutine, public distributed_matrix_storage_locations_get(DISTRIBUTED_MATRIX, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Gets the storage locations (sparsity pattern) for a distributed matrix.
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
This module handles all distributed matrix vector routines.
This module defines all constants shared across interface condition routines.
integer(intg), parameter, public distributed_matrix_compressed_column_storage_type
Distributed matrix compressed column storage type.
integer(intg), parameter interface_condition_point_to_point_method
Point to point interface condition method.
Contains information about an equations matrix.
Definition: types.f90:1429
integer(intg), parameter problem_solver_nonlinear
Nonlinear problem.
subroutine, public distributed_vector_library_type_set(DISTRIBUTED_VECTOR, LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the library type for a distributed vector.
subroutine solver_matrix_finalise(SOLVER_MATRIX, ERR, ERROR,)
Finalises a solver matrix and deallocates all memory.
subroutine, public distributed_matrix_output(ID, DISTRIBUTED_MATRIX, ERR, ERROR,)
Outputs a distributed matrix.
subroutine, public distributed_vector_data_type_set(DISTRIBUTED_VECTOR, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed vector.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
subroutine, public distributed_vector_destroy(DISTRIBUTED_VECTOR, ERR, ERROR,)
Destroys a distributed vector.
integer(intg), parameter, public solver_matrices_nonlinear_only
Select only the nonlinear solver matrices and vectors.
integer(intg), parameter, public matrix_row_column_storage_type
Matrix row-column storage type.
subroutine, public solver_matrices_destroy(SOLVER_MATRICES, ERR, ERROR,)
Destroy the solver matrices.
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
integer(intg), parameter, public solver_matrices_jacobian_only
Select only the Jacobian solver matrix.
Contains information on the solver matrices and rhs vector.
Definition: types.f90:2427
subroutine, public solver_matrix_interface_matrix_add(SOLVER_MATRIX, interface_condition_idx, ALPHA, INTERFACE_MATRIX, ERR, ERROR,)
Adds alpha times the interface matrix into the solver matrix.
integer(intg), parameter, public solver_matrices_all
Select all the solver matrices and vectors.
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
Contains information on the interface matrices.
Definition: types.f90:2012
subroutine solver_matrices_finalise(SOLVER_MATRICES, ERR, ERROR,)
Finalises the solver matrices and deallocates all memory.
Contains the information for a matrix that is distributed across a number of domains.
Definition: types.f90:828
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter, public distributed_matrix_vector_petsc_type
PETSc distributed matrix-vector library type.
integer(intg), parameter, public distributed_matrix_row_column_storage_type
Distributed matrix row-column storage type.
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.
integer(intg), parameter, public matrix_column_major_storage_type
Matrix column major storage type.
Flags an error condition.
Buffer type to allow arrays of pointers to a list.
Definition: types.f90:108
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
subroutine, public solver_matrices_library_type_set(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Sets the library type for the solver matrices (and vectors)
This module contains all kind definitions.
Definition: kinds.f90:45
subroutine, public solver_matrices_output(ID, SELECTION_TYPE, SOLVER_MATRICES, ERR, ERROR,)
Outputs the solver matrices.
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471