OpenCMISS-Iron Internal API Documentation
cmiss_petsc.f90
Go to the documentation of this file.
1 
43 
45 MODULE cmisspetsc
46 
47  USE base_routines
48  USE cmisspetsctypes
49  USE kinds
51  USE strings
52  USE types
53 
54 #include "macros.h"
55 
56  IMPLICIT NONE
57 
58  PRIVATE
59 
60 #include "petscversion.h"
61 #include "petsc/finclude/petsc.h"
62 
63  !Module parameters
64 
65  !Insert mode types
70  insertmode, PARAMETER :: petsc_insert_values = insert_values
71  insertmode, PARAMETER :: petsc_add_values = add_values
73 
74  !Scatter mode types
75  scattermode, PARAMETER :: petsc_scatter_forward = scatter_forward
76  scattermode, PARAMETER :: petsc_scatter_reverse = scatter_reverse
77 
78  !KSP types
83  ksptype, PARAMETER :: petsc_ksprichardson = ksprichardson
84  ksptype, PARAMETER :: petsc_kspchebyshev = kspchebyshev
85  ksptype, PARAMETER :: petsc_kspcg = kspcg
86  ksptype, PARAMETER :: petsc_kspcgne = kspcgne
87  ksptype, PARAMETER :: petsc_kspnash = kspnash
88  ksptype, PARAMETER :: petsc_kspstcg = kspstcg
89  ksptype, PARAMETER :: petsc_kspgltr = kspgltr
90  ksptype, PARAMETER :: petsc_kspgmres = kspgmres
91  ksptype, PARAMETER :: petsc_kspfgmres = kspfgmres
92  ksptype, PARAMETER :: petsc_ksplgmres = ksplgmres
93  ksptype, PARAMETER :: petsc_kspdgmres = kspdgmres
94  ksptype, PARAMETER :: petsc_ksppgmres = ksppgmres
95  ksptype, PARAMETER :: petsc_ksptcqmr = ksptcqmr
96  ksptype, PARAMETER :: petsc_kspbcgs = kspbcgs
97  ksptype, PARAMETER :: petsc_kspibcgs = kspibcgs
98  ksptype, PARAMETER :: petsc_kspfbcgs = kspfbcgs
99  ksptype, PARAMETER :: petsc_kspfbcgsr = kspfbcgsr
100  ksptype, PARAMETER :: petsc_kspbcgsl = kspbcgsl
101  ksptype, PARAMETER :: petsc_kspcgs = kspcgs
102  ksptype, PARAMETER :: petsc_ksptfqmr = ksptfqmr
103  ksptype, PARAMETER :: petsc_kspcr = kspcr
104  ksptype, PARAMETER :: petsc_ksplsqr = ksplsqr
105  ksptype, PARAMETER :: petsc_ksppreonly = ksppreonly
106  ksptype, PARAMETER :: petsc_kspqcg = kspqcg
107  ksptype, PARAMETER :: petsc_kspbicg = kspbicg
108  ksptype, PARAMETER :: petsc_kspminres = kspminres
109  ksptype, PARAMETER :: petsc_kspsymmlq = kspsymmlq
110  ksptype, PARAMETER :: petsc_ksplcd = ksplcd
111  ksptype, PARAMETER :: petsc_ksppython = ksppython
112  ksptype, PARAMETER :: petsc_kspgcr = kspgcr
114 
115  !KSPConvergedReason types
116  kspconvergedreason, PARAMETER :: petsc_ksp_converged_rtol = ksp_converged_rtol
117  kspconvergedreason, PARAMETER :: petsc_ksp_converged_atol = ksp_converged_atol
118  kspconvergedreason, PARAMETER :: petsc_ksp_converged_its = ksp_converged_its
119  kspconvergedreason, PARAMETER :: petsc_ksp_converged_iterating = ksp_converged_iterating
120  kspconvergedreason, PARAMETER :: petsc_ksp_converged_cg_neg_curve = ksp_converged_cg_neg_curve
121  kspconvergedreason, PARAMETER :: petsc_ksp_converged_cg_constrained = ksp_converged_cg_constrained
122  kspconvergedreason, PARAMETER :: petsc_ksp_converged_step_length = ksp_converged_step_length
123  kspconvergedreason, PARAMETER :: petsc_ksp_converged_happy_breakdown = ksp_converged_happy_breakdown
124  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_null = ksp_diverged_null
125  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_its = ksp_diverged_its
126  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_dtol = ksp_diverged_dtol
127  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_breakdown = ksp_diverged_breakdown
128  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_breakdown_bicg = ksp_diverged_breakdown_bicg
129  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_nonsymmetric = ksp_diverged_nonsymmetric
130  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_indefinite_pc = ksp_diverged_indefinite_pc
131  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_nanorinf = ksp_diverged_nanorinf
132  kspconvergedreason, PARAMETER :: petsc_ksp_diverged_indefinite_mat = ksp_diverged_indefinite_mat
133 
134  !KSPNorm types
135  kspnormtype, PARAMETER :: petsc_ksp_norm_none = ksp_norm_none
136  kspnormtype, PARAMETER :: petsc_ksp_norm_preconditioned = ksp_norm_preconditioned
137  kspnormtype, PARAMETER :: petsc_ksp_norm_unpreconditioned = ksp_norm_unpreconditioned
138  kspnormtype, PARAMETER :: petsc_ksp_norm_natural = ksp_norm_natural
139 
140  !MatAssembly types
141  matassemblytype, PARAMETER :: petsc_mat_flush_assembly = mat_flush_assembly
142  matassemblytype, PARAMETER :: petsc_mat_final_assembly = mat_final_assembly
143 
144  !MatDuplicate types
145  matduplicateoption, PARAMETER :: petsc_mat_do_not_copy_values = mat_do_not_copy_values
146  matduplicateoption, PARAMETER :: petsc_mat_copy_values = mat_copy_values
147  matduplicateoption, PARAMETER :: petsc_mat_share_nonzero_pattern = mat_share_nonzero_pattern
148 
149  !MatFactor types
150  matfactortype, PARAMETER :: petsc_mat_factor_none = mat_factor_none
151  matfactortype, PARAMETER :: petsc_mat_factor_lu = mat_factor_lu
152  matfactortype, PARAMETER :: petsc_mat_factor_cholesky = mat_factor_cholesky
153  matfactortype, PARAMETER :: petsc_mat_factor_ilu = mat_factor_ilu
154  matfactortype, PARAMETER :: petsc_mat_factor_icc = mat_factor_icc
155 
156  !MatInfo types
157  matinfo, PARAMETER :: petsc_mat_info_size = mat_info_size
158  matinfo, PARAMETER :: petsc_mat_info_block_size = mat_info_block_size
159  matinfo, PARAMETER :: petsc_mat_info_nz_allocated = mat_info_nz_allocated
160  matinfo, PARAMETER :: petsc_mat_info_nz_used = mat_info_nz_used
161  matinfo, PARAMETER :: petsc_mat_info_nz_unneeded = mat_info_nz_unneeded
162  matinfo, PARAMETER :: petsc_mat_info_memory = mat_info_memory
163  matinfo, PARAMETER :: petsc_mat_info_assemblies = mat_info_assemblies
164  matinfo, PARAMETER :: petsc_mat_info_mallocs = mat_info_mallocs
165  matinfo, PARAMETER :: petsc_mat_info_fill_ratio_given = mat_info_fill_ratio_given
166  matinfo, PARAMETER :: petsc_mat_info_fill_ratio_needed = mat_info_fill_ratio_needed
167  matinfo, PARAMETER :: petsc_mat_info_factor_mallocs = mat_info_factor_mallocs
168 
169  !MatInfoType types
170  matinfotype, PARAMETER :: petsc_mat_local = mat_local
171  matinfotype, PARAMETER :: petsc_mat_global_max = mat_global_max
172  matinfotype, PARAMETER :: petsc_mat_global_sum = mat_global_sum
173 
174  !MatOption types
179  matoption, PARAMETER :: petsc_mat_row_oriented = mat_row_oriented
180  matoption, PARAMETER :: petsc_mat_new_nonzero_locations = mat_new_nonzero_locations
181  matoption, PARAMETER :: petsc_mat_symmetric = mat_symmetric
182  matoption, PARAMETER :: petsc_mat_structurally_symmetric = mat_structurally_symmetric
183  matoption, PARAMETER :: petsc_mat_new_diagonals = mat_new_diagonals
184  matoption, PARAMETER :: petsc_mat_ignore_off_proc_entries = mat_ignore_off_proc_entries
185  matoption, PARAMETER :: petsc_mat_new_nonzero_location_err = mat_new_nonzero_location_err
186  matoption, PARAMETER :: petsc_mat_new_nonzero_allocation_err = mat_new_nonzero_allocation_err
187  matoption, PARAMETER :: petsc_mat_use_hash_table = mat_use_hash_table
188  matoption, PARAMETER :: petsc_mat_keep_nonzero_pattern = mat_keep_nonzero_pattern
189  matoption, PARAMETER :: petsc_mat_ignore_zero_entries = mat_ignore_zero_entries
190  matoption, PARAMETER :: petsc_mat_use_inodes = mat_use_inodes
191  matoption, PARAMETER :: petsc_mat_hermitian = mat_hermitian
192  matoption, PARAMETER :: petsc_mat_symmetry_eternal = mat_symmetry_eternal
193  matoption, PARAMETER :: petsc_mat_dummy = mat_dummy
194  matoption, PARAMETER :: petsc_mat_ignore_lower_triangular = mat_ignore_lower_triangular
195  matoption, PARAMETER :: petsc_mat_error_lower_triangular = mat_error_lower_triangular
196  matoption, PARAMETER :: petsc_mat_getrow_uppertriangular = mat_getrow_uppertriangular
197  matoption, PARAMETER :: petsc_mat_unused_nonzero_location_err = mat_unused_nonzero_location_err
198  matoption, PARAMETER :: petsc_num_mat_options = mat_option_max
199  matoption, PARAMETER :: petsc_mat_spd = mat_spd
200  matoption, PARAMETER :: petsc_mat_no_off_proc_entries = mat_no_off_proc_entries
201  matoption, PARAMETER :: petsc_mat_no_off_proc_zero_rows = mat_no_off_proc_zero_rows
203 
204  !Matrix Solver Package types
205  matsolverpackage, PARAMETER :: petsc_mat_solver_superlu = matsolversuperlu
206  matsolverpackage, PARAMETER :: petsc_mat_solver_superlu_dist = matsolversuperlu_dist
207  matsolverpackage, PARAMETER :: petsc_mat_solver_umfpack = matsolverumfpack
208  matsolverpackage, PARAMETER :: petsc_mat_solver_cholmod = matsolvercholmod
209  matsolverpackage, PARAMETER :: petsc_mat_solver_essl = matsolveressl
210  matsolverpackage, PARAMETER :: petsc_mat_solver_lusol = matsolverlusol
211  matsolverpackage, PARAMETER :: petsc_mat_solver_mumps = matsolvermumps
212  matsolverpackage, PARAMETER :: petsc_mat_solver_pastix = matsolverpastix
213  matsolverpackage, PARAMETER :: petsc_mat_solver_matlab = matsolvermatlab
214  matsolverpackage, PARAMETER :: petsc_mat_solver_petsc = matsolverpetsc
215  matsolverpackage, PARAMETER :: petsc_mat_solver_bas = matsolverbas
216  matsolverpackage, PARAMETER :: petsc_mat_solver_cusparse = matsolvercusparse
217  matsolverpackage, PARAMETER :: petsc_mat_solver_bstrm = matsolverbstrm
218  matsolverpackage, PARAMETER :: petsc_mat_solver_sbstrm = matsolversbstrm
219 
220  !MatStructure types
221  matstructure, PARAMETER :: petsc_different_nonzero_pattern = different_nonzero_pattern
222  matstructure, PARAMETER :: petsc_subset_nonzero_pattern = subset_nonzero_pattern
223  matstructure, PARAMETER :: petsc_same_nonzero_pattern = same_nonzero_pattern
224 
225  !MatReuse types
226  matreuse, PARAMETER :: petsc_mat_initial_matrix = mat_initial_matrix
227  matreuse, PARAMETER :: petsc_mat_reuse_matrix = mat_reuse_matrix
228  matreuse, PARAMETER :: petsc_mat_ignore_matrix = mat_ignore_matrix
229 
230  !MatColoring types
231  matcoloringtype, PARAMETER :: petsc_matcoloring_natural = matcoloringnatural
232  matcoloringtype, PARAMETER :: petsc_matcoloring_sl = matcoloringsl
233  matcoloringtype, PARAMETER :: petsc_matcoloring_lf = matcoloringlf
234  matcoloringtype, PARAMETER :: petsc_matcoloring_id = matcoloringid
235  matcoloringtype, PARAMETER :: petsc_matcoloring_greedy = matcoloringgreedy
236  matcoloringtype, PARAMETER :: petsc_matcoloring_jp = matcoloringjp
237 
238  !Norm types
239  normtype, PARAMETER :: petsc_norm_1 = norm_1
240  normtype, PARAMETER :: petsc_norm_2 = norm_2
241  normtype, PARAMETER :: petsc_norm_infinity = norm_infinity
242 
243  !PC types
244  pctype, PARAMETER :: petsc_pcnone = pcnone
245  pctype, PARAMETER :: petsc_pcjacobi = pcjacobi
246  pctype, PARAMETER :: petsc_pcsor = pcsor
247  pctype, PARAMETER :: petsc_pclu = pclu
248  pctype, PARAMETER :: petsc_pcshell = pcshell
249  pctype, PARAMETER :: petsc_pcbjacobi = pcbjacobi
250  pctype, PARAMETER :: petsc_pcmg = pcmg
251  pctype, PARAMETER :: petsc_pceisenstat = pceisenstat
252  pctype, PARAMETER :: petsc_pcilu = pcilu
253  pctype, PARAMETER :: petsc_pcicc = pcicc
254  pctype, PARAMETER :: petsc_pcasm = pcasm
255  pctype, PARAMETER :: petsc_pcksp = pcksp
256  pctype, PARAMETER :: petsc_pccomposite = pccomposite
257  pctype, PARAMETER :: petsc_pcredundant = pcredundant
258  pctype, PARAMETER :: petsc_pcspai = pcspai
259  pctype, PARAMETER :: petsc_pcnn = pcnn
260  pctype, PARAMETER :: petsc_pccholesky = pccholesky
261  pctype, PARAMETER :: petsc_pcpbjacobi = pcpbjacobi
262  pctype, PARAMETER :: petsc_pcmat = pcmat
263  pctype, PARAMETER :: petsc_pchypre = pchypre
264  pctype, PARAMETER :: petsc_pcparms = pcparms
265  pctype, PARAMETER :: petsc_pcfieldsplit = pcfieldsplit
266  pctype, PARAMETER :: petsc_pctfs = pctfs
267  pctype, PARAMETER :: petsc_pcml = pcml
268  pctype, PARAMETER :: petsc_pcgalerkin = pcgalerkin
269  pctype, PARAMETER :: petsc_pcexotic = pcexotic
270  pctype, PARAMETER :: petsc_pcsupportgraph = pcsupportgraph
271  pctype, PARAMETER :: petsc_pccp = pccp
272  pctype, PARAMETER :: petsc_pcbfbt = pcbfbt
273  pctype, PARAMETER :: petsc_pclsc = pclsc
274  pctype, PARAMETER :: petsc_pcpython = pcpython
275  pctype, PARAMETER :: petsc_pcpfmg = pcpfmg
276  pctype, PARAMETER :: petsc_pcsyspfmg = pcsyspfmg
277  pctype, PARAMETER :: petsc_pcredistribute = pcredistribute
278  pctype, PARAMETER :: petsc_pcsvd = pcsvd
279  pctype, PARAMETER :: petsc_pcgamg = pcgamg
280  pctype, PARAMETER :: petsc_pcgasm = pcgasm
281  pctype, PARAMETER :: petsc_pcsacusp = pcsacusp
282  pctype, PARAMETER :: petsc_pcsacusppoly = pcsacusppoly
283  pctype, PARAMETER :: petsc_pcbicgstabcusp = pcbicgstabcusp
284  pctype, PARAMETER :: petsc_pcainvcusp = pcainvcusp
285  pctype, PARAMETER :: petsc_pcbddc = pcbddc
286 
287  !SNES types
288  snestype, PARAMETER :: petsc_snesnewtonls = snesnewtonls
289  snestype, PARAMETER :: petsc_snesnewtontr = snesnewtontr
290  snestype, PARAMETER :: petsc_snespython = snespython
291  snestype, PARAMETER :: petsc_snestest = snestest
292  snestype, PARAMETER :: petsc_snesnrichardson = snesnrichardson
293  snestype, PARAMETER :: petsc_snesksponly = snesksponly
294  snestype, PARAMETER :: petsc_snesvinewtonrsls = snesvinewtonrsls
295  snestype, PARAMETER :: petsc_snesvinewtonssls = snesvinewtonssls
296  snestype, PARAMETER :: petsc_snesngmres = snesngmres
297  snestype, PARAMETER :: petsc_snesqn = snesqn
298  snestype, PARAMETER :: petsc_snesshell = snesshell
299  snestype, PARAMETER :: petsc_snesncg = snesncg
300  snestype, PARAMETER :: petsc_snesfas = snesfas
301  snestype, PARAMETER :: petsc_snesms = snesms
302 
303  !SNES converged types
304  snesconvergedreason, PARAMETER :: petsc_snes_converged_fnorm_abs = snes_converged_fnorm_abs
305  snesconvergedreason, PARAMETER :: petsc_snes_converged_fnorm_relative = snes_converged_fnorm_relative
306  snesconvergedreason, PARAMETER :: petsc_snes_converged_snorm_relative = snes_converged_snorm_relative
307  snesconvergedreason, PARAMETER :: petsc_snes_converged_its = snes_converged_its
308  snesconvergedreason, PARAMETER :: petsc_snes_converged_tr_delta = snes_converged_tr_delta
309  snesconvergedreason, PARAMETER :: petsc_snes_diverged_function_domain = snes_diverged_function_domain
310  snesconvergedreason, PARAMETER :: petsc_snes_diverged_function_count = snes_diverged_function_count
311  snesconvergedreason, PARAMETER :: petsc_snes_diverged_linear_solve = snes_diverged_linear_solve
312  snesconvergedreason, PARAMETER :: petsc_snes_diverged_fnorm_nan = snes_diverged_fnorm_nan
313  snesconvergedreason, PARAMETER :: petsc_snes_diverged_max_it = snes_diverged_max_it
314  snesconvergedreason, PARAMETER :: petsc_snes_diverged_line_search = snes_diverged_line_search
315  snesconvergedreason, PARAMETER :: petsc_snes_diverged_local_min = snes_diverged_local_min
316  snesconvergedreason, PARAMETER :: petsc_snes_converged_iterating = snes_converged_iterating
317 
318  !SNES line search type
319  sneslinesearchtype, PARAMETER :: petsc_snes_linesearch_basic = sneslinesearchbasic
320  sneslinesearchtype, PARAMETER :: petsc_snes_linesearch_bt = sneslinesearchbt
321  sneslinesearchtype, PARAMETER :: petsc_snes_linesearch_l2 = sneslinesearchl2
322  sneslinesearchtype, PARAMETER :: petsc_snes_linesearch_cp = sneslinesearchcp
323  sneslinesearchtype, PARAMETER :: petsc_snes_linesearch_shell = sneslinesearchshell
324 
325  !SNES line search order
326  sneslinesearchorder, PARAMETER :: petsc_snes_linesearch_order_linear = snes_linesearch_order_linear
327  sneslinesearchorder, PARAMETER :: petsc_snes_linesearch_order_quadratic = snes_linesearch_order_quadratic
328  sneslinesearchorder, PARAMETER :: petsc_snes_linesearch_order_cubic = snes_linesearch_order_cubic
329 
330  !SNES norm schedules
331  snesnormschedule, PARAMETER :: petsc_snes_norm_default = snes_norm_default
332  snesnormschedule, PARAMETER :: petsc_snes_norm_none = snes_norm_none
333  snesnormschedule, PARAMETER :: petsc_snes_norm_always = snes_norm_always
334  snesnormschedule, PARAMETER :: petsc_snes_norm_initial_only = snes_norm_initial_only
335  snesnormschedule, PARAMETER :: petsc_snes_norm_final_only = snes_norm_final_only
336  snesnormschedule, PARAMETER :: petsc_snes_norm_initial_final_only = snes_norm_initial_final_only
337 
338  !SNES QN types
339  snesqntype, PARAMETER :: petsc_snes_qn_lbfgs = snes_qn_lbfgs
340  snesqntype, PARAMETER :: petsc_snes_qn_broyden = snes_qn_broyden
341  snesqntype, PARAMETER :: petsc_snes_qn_badbroyden = snes_qn_badbroyden
342 
343  !SNES QN restart types
344  snesqnrestarttype, PARAMETER :: petsc_snes_qn_restart_default = snes_qn_restart_default
345  snesqnrestarttype, PARAMETER :: petsc_snes_qn_restart_none = snes_qn_restart_none
346  snesqnrestarttype, PARAMETER :: petsc_snes_qn_restart_powell = snes_qn_restart_powell
347  snesqnrestarttype, PARAMETER :: petsc_snes_qn_restart_periodic = snes_qn_restart_periodic
348 
349  !SNES QN scaling types
350  snesqnscaletype, PARAMETER :: petsc_snes_qn_scale_default = snes_qn_scale_default
351  snesqnscaletype, PARAMETER :: petsc_snes_qn_scale_none = snes_qn_scale_none
352  snesqnscaletype, PARAMETER :: petsc_snes_qn_scale_shanno = snes_qn_scale_shanno
353  snesqnscaletype, PARAMETER :: petsc_snes_qn_scale_linesearch = snes_qn_scale_linesearch
354  snesqnscaletype, PARAMETER :: petsc_snes_qn_scale_jacobian = snes_qn_scale_jacobian
355 
356  !TS types
357  tstype, PARAMETER :: petsc_ts_euler = tseuler
358  tstype, PARAMETER :: petsc_ts_beuler = tsbeuler
359  tstype, PARAMETER :: petsc_ts_pseudo = tspseudo
360  tstype, PARAMETER :: petsc_ts_cn = tscn
361  tstype, PARAMETER :: petsc_ts_sundials = tssundials
362  tstype, PARAMETER :: petsc_ts_rk = tsrk
363  tstype, PARAMETER :: petsc_ts_python = tspython
364  tstype, PARAMETER :: petsc_ts_theta = tstheta
365  tstype, PARAMETER :: petsc_ts_alpha = tsalpha
366  tstype, PARAMETER :: petsc_ts_gl = tsgl
367  tstype, PARAMETER :: petsc_ts_ssp = tsssp
368  tstype, PARAMETER :: petsc_ts_arkimex = tsarkimex
369  tstype, PARAMETER :: petsc_ts_rosw = tsrosw
370  tstype, PARAMETER :: petsc_ts_eimex = tseimex
371 
372  !TS convergence flags
373  tsconvergedreason, PARAMETER :: petsc_ts_converged_iterating = ts_converged_iterating
374  tsconvergedreason, PARAMETER :: petsc_ts_converged_time = ts_converged_time
375  tsconvergedreason, PARAMETER :: petsc_ts_converged_its = ts_converged_its
376  tsconvergedreason, PARAMETER :: petsc_ts_diverged_nonlinear_solve = ts_diverged_nonlinear_solve
377  tsconvergedreason, PARAMETER :: petsc_ts_diverged_step_rejected = ts_diverged_step_rejected
378 
379  !TS problem types
380  tsproblemtype, PARAMETER :: petsc_ts_linear = ts_linear
381  tsproblemtype, PARAMETER :: petsc_ts_nonlinear = ts_nonlinear
382 
383  !TS Sundials types
384  tssundialstype, PARAMETER :: petsc_sundials_adams = sundials_adams
385  tssundialstype, PARAMETER :: petsc_sundials_bdf = sundials_bdf
386 
387  !TS Sundials Gram Schmidt Type
388  tssundialsgramschmidttype, PARAMETER :: petsc_sundials_modified_gs = sundials_modified_gs
389  tssundialsgramschmidttype, PARAMETER :: petsc_sundials_classical_gs = sundials_classical_gs
390 
391  !Module types
392 
393  !Module variables
394 
395  LOGICAL, SAVE :: petschandleerror
396 
397  !Interfaces
398 
399  INTERFACE
400 
401  !PETSc miscellanous routines
402 
403  SUBROUTINE petscfinalize(ierr)
404  petscint ierr
405  END SUBROUTINE petscfinalize
406 
407  SUBROUTINE petscinitialize(file,ierr)
408  CHARACTER(LEN=*) file
409  petscint ierr
410  END SUBROUTINE petscinitialize
411 
412  SUBROUTINE petscpopsignalhandler(ierr)
413  petscint ierr
414  END SUBROUTINE petscpopsignalhandler
415 
416  SUBROUTINE petsclogview(viewer,ierr)
417  petscviewer viewer
418  petscint ierr
419  END SUBROUTINE petsclogview
420 
421  !IS routines
422 
423  SUBROUTINE isdestroy(indexset,ierr)
424  is indexset
425  petscint ierr
426  END SUBROUTINE isdestroy
427 
428  !IS coloring routines
429 
430  SUBROUTINE iscoloringdestroy(iscoloring,ierr)
431  iscoloring iscoloring
432  petscint ierr
433  END SUBROUTINE iscoloringdestroy
434 
435  !IS local to global mapping routines
436 
437  SUBROUTINE islocaltoglobalmappingapply(islocaltoglobalmapping,n,idxin,idxout,ierr)
438  islocaltoglobalmapping islocaltoglobalmapping
439  petscint n
440  petscint idxin(*)
441  petscint idxout(*)
442  petscint ierr
443  END SUBROUTINE islocaltoglobalmappingapply
444 
445  SUBROUTINE islocaltoglobalmappingapplyis(islocaltoglobalmapping,isin,isout,ierr)
446  islocaltoglobalmapping islocaltoglobalmapping
447  is isin
448  is isout
449  petscint ierr
450  END SUBROUTINE islocaltoglobalmappingapplyis
451 
452  SUBROUTINE islocaltoglobalmappingcreate(comm,blockSize,n,indices,mode,islocaltoglobalmapping,ierr)
453  mpi_comm comm
454  petscint blocksize
455  petscint n
456  petscint indices(*)
457  petsccopymode mode
458  islocaltoglobalmapping islocaltoglobalmapping
459  petscint ierr
460  END SUBROUTINE islocaltoglobalmappingcreate
461 
462  SUBROUTINE islocaltoglobalmappingdestroy(islocaltoglobalmapping,ierr)
463  islocaltoglobalmapping islocaltoglobalmapping
464  petscint ierr
465  END SUBROUTINE islocaltoglobalmappingdestroy
466 
467  !KSP routines
468 
469  SUBROUTINE kspcreate(comm,ksp,ierr)
470  mpi_comm comm
471  ksp ksp
472  petscint ierr
473  END SUBROUTINE kspcreate
474 
475  SUBROUTINE kspdestroy(ksp,ierr)
476  ksp ksp
477  petscint ierr
478  END SUBROUTINE kspdestroy
479 
480  SUBROUTINE kspgetconvergedreason(ksp,reason,ierr)
481  ksp ksp
482  kspconvergedreason reason
483  petscint ierr
484  END SUBROUTINE kspgetconvergedreason
485 
486  SUBROUTINE kspgetiterationnumber(ksp,its,ierr)
487  ksp ksp
488  petscint its
489  petscint ierr
490  END SUBROUTINE kspgetiterationnumber
491 
492  SUBROUTINE kspgetpc(ksp,pc,ierr)
493  ksp ksp
494  pc pc
495  petscint ierr
496  END SUBROUTINE kspgetpc
497 
498  SUBROUTINE kspgetresidualnorm(ksp,rnorm,ierr)
499  ksp ksp
500  petscreal rnorm
501  petscint ierr
502  END SUBROUTINE kspgetresidualnorm
503 
504  SUBROUTINE kspgmressetrestart(ksp,restart,ierr)
505  ksp ksp
506  petscint restart
507  petscint ierr
508  END SUBROUTINE kspgmressetrestart
509 
510  SUBROUTINE kspsetfromoptions(ksp,ierr)
511  ksp ksp
512  petscint ierr
513  END SUBROUTINE kspsetfromoptions
514 
515  SUBROUTINE kspsetinitialguessnonzero(ksp,flg,ierr)
516  ksp ksp
517  petscbool flg
518  petscint ierr
519  END SUBROUTINE kspsetinitialguessnonzero
520 
521  SUBROUTINE kspsetoperators(ksp,amat,pmat,ierr)
522  ksp ksp
523  mat amat
524  mat pmat
525  petscint ierr
526  END SUBROUTINE kspsetoperators
527 
528  SUBROUTINE kspsetreusepreconditioner(ksp,flag,ierr)
529  ksp ksp
530  petscbool flag
531  petscint ierr
532  END SUBROUTINE kspsetreusepreconditioner
533 
534  SUBROUTINE kspsettolerances(ksp,rtol,atol,dtol,maxits,ierr)
535  ksp ksp
536  petscreal rtol
537  petscreal atol
538  petscreal dtol
539  petscint maxits
540  petscint ierr
541  END SUBROUTINE kspsettolerances
542 
543  SUBROUTINE kspsettype(ksp,method,ierr)
544  ksp ksp
545  ksptype method
546  petscint ierr
547  END SUBROUTINE kspsettype
548 
549  SUBROUTINE kspsetup(ksp,ierr)
550  ksp ksp
551  petscint ierr
552  END SUBROUTINE kspsetup
553 
554  SUBROUTINE kspsolve(ksp,b,x,ierr)
555  ksp ksp
556  vec b
557  vec x
558  petscint ierr
559  END SUBROUTINE kspsolve
560 
561  !Matrix routines
562 
563  SUBROUTINE matassemblybegin(A,assemblytype,ierr)
564  mat a
565  matassemblytype assemblytype
566  petscint ierr
567  END SUBROUTINE matassemblybegin
568 
569  SUBROUTINE matassemblyend(A,assemblytype,ierr)
570  mat a
571  matassemblytype assemblytype
572  petscint ierr
573  END SUBROUTINE matassemblyend
574 
575  SUBROUTINE matcreate(comm,A,ierr)
576  mpi_comm comm
577  mat a
578  petscint ierr
579  END SUBROUTINE matcreate
580 
581  SUBROUTINE matcreateaij(comm,localm,localn,globalm,globaln,diagnumbernzperrow,diagnumbernzeachrow,offdiagnumbernzperrow, &
582  & offdiagnumbernzeachrow,a,ierr)
583  mpi_comm comm
584  petscint localm
585  petscint localn
586  petscint globalm
587  petscint globaln
588  petscint diagnumbernzperrow
589  petscint diagnumbernzeachrow(*)
590  petscint offdiagnumbernzperrow
591  petscint offdiagnumbernzeachrow(*)
592  mat a
593  petscint ierr
594  END SUBROUTINE matcreateaij
595 
596  SUBROUTINE matcreatedense(comm,localm,localn,globalm,globaln,matrixdata,A,ierr)
597  mpi_comm comm
598  petscint localm
599  petscint localn
600  petscint globalm
601  petscint globaln
602  petscscalar matrixdata(*)
603  mat a
604  petscint ierr
605  END SUBROUTINE matcreatedense
606 
607  SUBROUTINE matcreateseqaij(comm,m,n,numbernzperrow,numbernzeachrow,A,ierr)
608  mpi_comm comm
609  petscint m
610  petscint n
611  petscint numbernzperrow
612  petscint numbernzeachrow(*)
613  mat a
614  petscint ierr
615  END SUBROUTINE matcreateseqaij
616 
617  SUBROUTINE matcreateseqdense(comm,m,n,matrixdata,A,ierr)
618  mpi_comm comm
619  petscint m
620  petscint n
621  petscscalar matrixdata(*)
622  mat a
623  petscint ierr
624  END SUBROUTINE matcreateseqdense
625 
626  SUBROUTINE matdensegetarrayf90(A,array,ierr)
627  mat a
628  petscscalar, POINTER :: array(:,:)
629  petscint ierr
630  END SUBROUTINE matdensegetarrayf90
631 
632  SUBROUTINE matdenserestorearrayf90(A,array,ierr)
633  mat a
634  petscscalar, POINTER :: array(:,:)
635  petscint ierr
636  END SUBROUTINE matdenserestorearrayf90
637 
638  SUBROUTINE matdestroy(A,ierr)
639  mat a
640  petscint ierr
641  END SUBROUTINE matdestroy
642 
643  SUBROUTINE matgetinfo(A,flag,info,ierr)
644  mat a
645  matinfotype flag
646  matinfo info(*)
647  petscint ierr
648  END SUBROUTINE matgetinfo
649 
650  SUBROUTINE matgetownershiprange(A,firstrow,lastrow,ierr)
651  mat a
652  petscint firstrow
653  petscint lastrow
654  petscint ierr
655  END SUBROUTINE matgetownershiprange
656 
657  SUBROUTINE matgetrow(A,row,ncols,cols,values,ierr)
658  mat a
659  petscint row
660  petscint ncols
661  petscint cols(*)
662  petscscalar values(*)
663  petscint ierr
664  END SUBROUTINE matgetrow
665 
666  SUBROUTINE matgetvalues(A,m,idxm,n,idxn,values,ierr)
667  mat a
668  petscint m
669  petscint idxm(*)
670  petscint n
671  petscint idxn(*)
672  petscscalar values(*)
673  petscint ierr
674  END SUBROUTINE matgetvalues
675 
676  SUBROUTINE matmumpsseticntl(A,icntl,ival,ierr)
677  mat a
678  petscint icntl
679  petscint ival
680  petscint ierr
681  END SUBROUTINE matmumpsseticntl
682 
683  SUBROUTINE matmumpssetcntl(A,icntl,val,ierr)
684  mat a
685  petscint icntl
686  petscreal val
687  petscint ierr
688  END SUBROUTINE matmumpssetcntl
689 
690  SUBROUTINE matrestorerow(A,row,ncols,cols,values,ierr)
691  mat a
692  petscint row
693  petscint ncols
694  petscint cols(*)
695  petscscalar values(*)
696  petscint ierr
697  END SUBROUTINE matrestorerow
698 
699  SUBROUTINE matseqaijgetarrayf90(A,array,ierr)
700  mat a
701  petscscalar, POINTER :: array(:,:)
702  petscint ierr
703  END SUBROUTINE matseqaijgetarrayf90
704 
705  SUBROUTINE matseqaijgetmaxrownonzeros(A,maxNumberNonZeros,ierr)
706  mat a
707  petscint maxnumbernonzeros
708  petscint ierr
709  END SUBROUTINE matseqaijgetmaxrownonzeros
710 
711  SUBROUTINE matseqaijrestorearrayf90(A,array,ierr)
712  mat a
713  petscscalar, POINTER :: array(:,:)
714  petscint ierr
715  END SUBROUTINE matseqaijrestorearrayf90
716 
717  SUBROUTINE matsetlocaltoglobalmapping(A,ctx,ierr)
718  mat a
719  islocaltoglobalmapping ctx
720  petscint ierr
721  END SUBROUTINE matsetlocaltoglobalmapping
722 
723  SUBROUTINE matsetoption(A,option,flag,ierr)
724  mat a
725  matoption option
726  petscbool flag
727  petscint ierr
728  END SUBROUTINE matsetoption
729 
730  SUBROUTINE matsetsizes(A,localm,localn,globalM,globalN,ierr)
731  mat a
732  petscint localm
733  petscint localn
734  petscint globalm
735  petscint globaln
736  petscint ierr
737  END SUBROUTINE matsetsizes
738 
739  SUBROUTINE matsettype(A,matrixtype,ierr)
740  mat a
741  mattype matrixtype
742  petscint ierr
743  END SUBROUTINE matsettype
744 
745  SUBROUTINE matsetvalue(A,row,col,value,insertmode,ierr)
746  mat a
747  petscint row
748  petscint col
749  petscscalar value
750  insertmode insertmode
751  petscint ierr
752  END SUBROUTINE matsetvalue
753 
754  SUBROUTINE matsetvalues(A,m,mindices,n,nindices,values,insertmode,ierr)
755  mat a
756  petscint m
757  petscint mindices(*)
758  petscint n
759  petscint nindices(*)
760  petscscalar values(*)
761  insertmode insertmode
762  petscint ierr
763  END SUBROUTINE matsetvalues
764 
765  SUBROUTINE matsetvaluelocal(A,row,col,value,insertmode,ierr)
766  mat a
767  petscint row
768  petscint col
769  petscscalar value
770  insertmode insertmode
771  petscint ierr
772  END SUBROUTINE matsetvaluelocal
773 
774  SUBROUTINE matsetvalueslocal(A,m,mindices,n,nindices,values,insertmode,ierr)
775  mat a
776  petscint m
777  petscint mindices(*)
778  petscint n
779  petscint nindices(*)
780  petscscalar values(*)
781  insertmode insertmode
782  petscint ierr
783  END SUBROUTINE matsetvalueslocal
784 
785  SUBROUTINE matview(A,v,ierr)
786  mat a
787  petscviewer v
788  petscint ierr
789  END SUBROUTINE matview
790 
791  SUBROUTINE matzeroentries(A,ierr)
792  mat a
793  petscint ierr
794  END SUBROUTINE matzeroentries
795 
796  !Mat coloring routines
797 
798  SUBROUTINE matcoloringapply(coloring,isColoring,ierr)
799  matcoloring coloring
800  iscoloring iscoloring
801  petscint ierr
802  END SUBROUTINE matcoloringapply
803 
804  SUBROUTINE matcoloringcreate(A,coloring,ierr)
805  mat a
806  matcoloring coloring
807  petscint ierr
808  END SUBROUTINE matcoloringcreate
809 
810  SUBROUTINE matcoloringdestroy(coloring,ierr)
811  matcoloring coloring
812  petscint ierr
813  END SUBROUTINE matcoloringdestroy
814 
815  SUBROUTINE matcoloringsetfromoptions(coloring,ierr)
816  matcoloring coloring
817  petscint ierr
818  END SUBROUTINE matcoloringsetfromoptions
819 
820  SUBROUTINE matcoloringsettype(coloring,coloringType,ierr)
821  matcoloring coloring
822  matcoloringtype coloringtype
823  petscint ierr
824  END SUBROUTINE matcoloringsettype
825 
826  !Mat FD coloring routines
827 
828  SUBROUTINE matfdcoloringcreate(A,iscoloring,fdcoloring,ierr)
829  mat a
830  iscoloring iscoloring
831  matfdcoloring fdcoloring
832  petscint ierr
833  END SUBROUTINE matfdcoloringcreate
834 
835  SUBROUTINE matfdcoloringdestroy(fdcoloring,ierr)
836  matfdcoloring fdcoloring
837  petscint ierr
838  END SUBROUTINE matfdcoloringdestroy
839 
840  SUBROUTINE matfdcoloringsetfromoptions(fdcoloring,ierr)
841  matfdcoloring fdcoloring
842  petscint ierr
843  END SUBROUTINE matfdcoloringsetfromoptions
844 
845  SUBROUTINE matfdcoloringsetfunction(fdcoloring,ffunction,ctx,ierr)
846  USE types
847  matfdcoloring fdcoloring
848  EXTERNAL ffunction
849  TYPE(solver_type), POINTER :: ctx
850  petscint ierr
851  END SUBROUTINE matfdcoloringsetfunction
852 
853  SUBROUTINE matfdcoloringsetparameters(fdcoloring,rerror,umin,ierr)
854  matfdcoloring fdcoloring
855  petscscalar rerror
856  petscscalar umin
857  petscint ierr
858  END SUBROUTINE matfdcoloringsetparameters
859 
860  SUBROUTINE matfdcoloringsetup(A,iscoloring,fdcoloring,ierr)
861  mat a
862  iscoloring iscoloring
863  matfdcoloring fdcoloring
864  petscint ierr
865  END SUBROUTINE matfdcoloringsetup
866 
867  !Pre-conditioner routines
868 
869  SUBROUTINE pcfactorgetmatrix(pc,A,ierr)
870  pc pc
871  mat a
872  petscint ierr
873  END SUBROUTINE pcfactorgetmatrix
874 
875  SUBROUTINE pcfactorsetmatsolverpackage(pc,solverpackage,ierr)
876  pc pc
877  matsolverpackage solverpackage
878  petscint ierr
879  END SUBROUTINE pcfactorsetmatsolverpackage
880 
881  SUBROUTINE pcfactorsetupmatsolverpackage(pc,ierr)
882  pc pc
883  petscint ierr
884  END SUBROUTINE pcfactorsetupmatsolverpackage
885 
886  SUBROUTINE pcsetfromoptions(pc,ierr)
887  pc pc
888  petscint ierr
889  END SUBROUTINE pcsetfromoptions
890 
891  SUBROUTINE pcsetreusepreconditioner(pc,flag,ierr)
892  pc pc
893  petscbool flag
894  petscint ierr
895  END SUBROUTINE pcsetreusepreconditioner
896 
897  SUBROUTINE pcsettype(pc,method,ierr)
898  pc pc
899  pctype method
900  petscint ierr
901  END SUBROUTINE pcsettype
902 
903  !SNES routines
904 
905  SUBROUTINE snescreate(comm,snes,ierr)
906  mpi_comm comm
907  snes snes
908  petscint ierr
909  END SUBROUTINE snescreate
910 
911  SUBROUTINE snesdestroy(snes,ierr)
912  snes snes
913  petscint ierr
914  END SUBROUTINE snesdestroy
915 
916  SUBROUTINE snesgetapplicationcontext(snes,ctx,ierr)
917  USE types
918  snes snes
919  TYPE(solver_type), POINTER :: ctx
920  petscint ierr
921  END SUBROUTINE snesgetapplicationcontext
922 
923  SUBROUTINE snesgetconvergedreason(snes,reason,ierr)
924  snes snes
925  snesconvergedreason reason
926  petscint ierr
927  END SUBROUTINE snesgetconvergedreason
928 
929  SUBROUTINE snesgetfunction(snes,f,ffunction,ctx,ierr)
930  USE types
931  snes snes
932  vec f
933  EXTERNAL ffunction
934  petscint ctx
935  petscint ierr
936  END SUBROUTINE snesgetfunction
937 
938  SUBROUTINE snesgetiterationnumber(snes,iter,ierr)
939  snes snes
940  petscint iter
941  petscint ierr
942  END SUBROUTINE snesgetiterationnumber
943 
944  SUBROUTINE snesgetjacobian(snes,A,B,Jfunction,ctx,ierr)
945  USE types
946  snes snes
947  mat a
948  mat b
949  EXTERNAL jfunction
950  petscint ctx
951  petscint ierr
952  END SUBROUTINE snesgetjacobian
953 
954  SUBROUTINE snesgetksp(snes,ksp,ierr)
955  snes snes
956  ksp ksp
957  petscint ierr
958  END SUBROUTINE snesgetksp
959 
960  SUBROUTINE snesgetlinesearch(snes,linesearch,ierr)
961  snes snes
962  sneslinesearch linesearch
963  petscint ierr
964  END SUBROUTINE snesgetlinesearch
965 
966  SUBROUTINE snesgetsolutionupdate(snes,solutionUpdate,ierr)
967  snes snes
968  vec solutionupdate
969  petscint ierr
970  END SUBROUTINE snesgetsolutionupdate
971 
972  SUBROUTINE snesmonitorset(snes,mfunction,mctx,monitordestroy,ierr)
973  USE types
974  snes snes
975  EXTERNAL mfunction
976  TYPE(solver_type), POINTER :: mctx
977  EXTERNAL monitordestroy
978  petscint ierr
979  END SUBROUTINE snesmonitorset
980 
981  SUBROUTINE snesqnsetrestarttype(snes,rtype,ierr)
982  snes snes
983  snesqnrestarttype rtype
984  petscint ierr
985  END SUBROUTINE snesqnsetrestarttype
986 
987  SUBROUTINE snesqnsetscaletype(snes,stype,ierr)
988  snes snes
989  snesqnscaletype stype
990  petscint ierr
991  END SUBROUTINE snesqnsetscaletype
992 
993  SUBROUTINE snesqnsettype(snes,qtype,ierr)
994  snes snes
995  snesqntype qtype
996  petscint ierr
997  END SUBROUTINE snesqnsettype
998 
999  SUBROUTINE snessetapplicationcontext(snes,ctx,ierr)
1000  USE types
1001  snes snes
1002  TYPE(solver_type), POINTER :: ctx
1003  petscint ierr
1004  END SUBROUTINE snessetapplicationcontext
1005 
1006  SUBROUTINE snessetconvergencetest(snes,cfunction,ctx,destroyFunction,ierr)
1007  USE types
1008  snes snes
1009  EXTERNAL cfunction
1010  TYPE(solver_type), POINTER :: ctx
1011  EXTERNAL destroyfunction
1012  petscint ierr
1013  END SUBROUTINE snessetconvergencetest
1014 
1015  SUBROUTINE snessetfromoptions(snes,ierr)
1016  snes snes
1017  petscint ierr
1018  END SUBROUTINE snessetfromoptions
1019 
1020  SUBROUTINE snessetfunction(snes,f,ffunction,ctx,ierr)
1021  USE types
1022  snes snes
1023  vec f
1024  EXTERNAL ffunction
1025  TYPE(solver_type), POINTER :: ctx
1026  petscint ierr
1027  END SUBROUTINE snessetfunction
1028 
1029  SUBROUTINE snessetjacobian(snes,A,B,Jfunction,ctx,ierr)
1030  USE types
1031  snes snes
1032  mat a
1033  mat b
1034  EXTERNAL jfunction
1035  TYPE(solver_type), POINTER :: ctx
1036  petscint ierr
1037  END SUBROUTINE snessetjacobian
1038 
1039  SUBROUTINE snessetksp(snes,ksp,ierr)
1040  snes snes
1041  ksp ksp
1042  petscint ierr
1043  END SUBROUTINE snessetksp
1044 
1045  SUBROUTINE snessetnormschedule(snes,normschedule,ierr)
1046  snes snes
1047  snesnormschedule normschedule
1048  petscint ierr
1049  END SUBROUTINE snessetnormschedule
1050 
1051  SUBROUTINE snessettolerances(snes,abstol,rtol,stol,maxit,maxf,ierr)
1052  snes snes
1053  petscreal abstol
1054  petscreal rtol
1055  petscreal stol
1056  petscint maxit
1057  petscint maxf
1058  petscint ierr
1059  END SUBROUTINE snessettolerances
1060 
1061  SUBROUTINE snessettrustregiontolerance(snes,trtol,ierr)
1062  snes snes
1063  petscreal trtol
1064  petscint ierr
1065  END SUBROUTINE snessettrustregiontolerance
1066 
1067  SUBROUTINE snessettype(snes,method,ierr)
1068  snes snes
1069  snestype method
1070  petscint ierr
1071  END SUBROUTINE snessettype
1072 
1073  SUBROUTINE snessolve(snes,b,x,ierr)
1074  snes snes
1075  vec b
1076  vec x
1077  petscint ierr
1078  END SUBROUTINE snessolve
1079 
1080  !SNES line search routines
1081 
1082  SUBROUTINE sneslinesearchbtsetalpha(linesearch,alpha,ierr)
1083  sneslinesearch linesearch
1084  petscreal alpha
1085  petscint ierr
1086  END SUBROUTINE sneslinesearchbtsetalpha
1087 
1088  SUBROUTINE sneslinesearchcomputenorms(linesearch,ierr)
1089  sneslinesearch linesearch
1090  petscint ierr
1091  END SUBROUTINE sneslinesearchcomputenorms
1092 
1093  SUBROUTINE sneslinesearchgetnorms(linesearch,xnorm,fnorm,ynorm,ierr)
1094  sneslinesearch linesearch
1095  petscreal xnorm
1096  petscreal fnorm
1097  petscreal ynorm
1098  petscint ierr
1099  END SUBROUTINE sneslinesearchgetnorms
1100 
1101  SUBROUTINE sneslinesearchgetvecs(linesearch,x,f,y,w,g,ierr)
1102  sneslinesearch linesearch
1103  vec x
1104  vec f
1105  vec y
1106  vec w
1107  vec g
1108  petscint ierr
1109  END SUBROUTINE sneslinesearchgetvecs
1110 
1111  SUBROUTINE sneslinesearchsetcomputenorms(linesearch,flag,ierr)
1112  sneslinesearch linesearch
1113  petscbool flag
1114  petscint ierr
1115  END SUBROUTINE sneslinesearchsetcomputenorms
1116 
1117  SUBROUTINE sneslinesearchsetmonitor(linesearch,flag,ierr)
1118  sneslinesearch linesearch
1119  petscbool flag
1120  petscint ierr
1121  END SUBROUTINE sneslinesearchsetmonitor
1122 
1123  SUBROUTINE sneslinesearchsetnorms(snes,xnorm,fnorm,ynorm,ierr)
1124  snes snes
1125  petscreal xnorm
1126  petscreal fnorm
1127  petscreal ynorm
1128  petscint ierr
1129  END SUBROUTINE sneslinesearchsetnorms
1130 
1131  SUBROUTINE sneslinesearchsetorder(linesearch,linesearchorder,ierr)
1132  sneslinesearch linesearch
1133  sneslinesearchorder linesearchorder
1134  petscint ierr
1135  END SUBROUTINE sneslinesearchsetorder
1136 
1137  SUBROUTINE sneslinesearchsettolerances(linesearch,steptol,maxstep,rtol,atol,ltol,maxIt,ierr)
1138  sneslinesearch linesearch
1139  petscreal steptol
1140  petscreal maxstep
1141  petscreal rtol
1142  petscreal atol
1143  petscreal ltol
1144  petscint maxit
1145  petscint ierr
1146  END SUBROUTINE sneslinesearchsettolerances
1147 
1148  SUBROUTINE sneslinesearchsettype(linesearch,linesearchtype,ierr)
1149  sneslinesearch linesearch
1150  sneslinesearchtype linesearchtype
1151  petscint ierr
1152  END SUBROUTINE sneslinesearchsettype
1153 
1154  !Time stepping routines
1155 
1156  SUBROUTINE tscreate(comm,ts,ierr)
1157  mpi_comm comm
1158  ts ts
1159  petscint ierr
1160  END SUBROUTINE tscreate
1161 
1162  SUBROUTINE tsdestroy(ts,ierr)
1163  ts ts
1164  petscint ierr
1165  END SUBROUTINE tsdestroy
1166 
1167  SUBROUTINE tsgetsolution(ts,currentsolution,ierr)
1168  ts ts
1169  vec currentsolution
1170  petscint ierr
1171  END SUBROUTINE tsgetsolution
1172 
1173  SUBROUTINE tsmonitorset(ts,mfunction,mctx,monitordestroy,ierr)
1174  USE types
1175  ts ts
1176  EXTERNAL mfunction
1177  TYPE(solver_type), POINTER :: mctx
1178  EXTERNAL monitordestroy
1179  petscint ierr
1180  END SUBROUTINE tsmonitorset
1181 
1182  SUBROUTINE tssetduration(ts,maxsteps,maxtime,ierr)
1183  ts ts
1184  petscint maxsteps
1185  petscreal maxtime
1186  petscint ierr
1187  END SUBROUTINE tssetduration
1188 
1189  SUBROUTINE tssetexactfinaltime(ts,eftopt,ierr)
1190  ts ts
1191  petscbool eftopt
1192  petscint ierr
1193  END SUBROUTINE tssetexactfinaltime
1194 
1195  SUBROUTINE tssetfromoptions(ts,ierr)
1196  ts ts
1197  petscint ierr
1198  END SUBROUTINE tssetfromoptions
1199 
1200  SUBROUTINE tssetinitialtimestep(ts,initial_time,time_step,ierr)
1201  ts ts
1202  petscreal initial_time
1203  petscreal time_step
1204  petscint ierr
1205  END SUBROUTINE tssetinitialtimestep
1206 
1207  SUBROUTINE tssetproblemtype(ts,probtype,ierr)
1208  ts ts
1209  tsproblemtype probtype
1210  petscint ierr
1211  END SUBROUTINE tssetproblemtype
1212 
1213  SUBROUTINE tssetrhsfunction(ts,r,rhsfunc,ctx,ierr)
1214  USE types
1215  ts ts
1216  vec r
1217  EXTERNAL rhsfunc
1218  TYPE(cellmlpetsccontexttype), POINTER :: ctx
1219  petscint ierr
1220  END SUBROUTINE tssetrhsfunction
1221 
1222  SUBROUTINE tssetsolution(ts,initialsolution,ierr)
1223  ts ts
1224  vec initialsolution
1225  petscint ierr
1226  END SUBROUTINE tssetsolution
1227 
1228  SUBROUTINE tssettimestep(ts,time_step,ierr)
1229  ts ts
1230  petscreal time_step
1231  petscint ierr
1232  END SUBROUTINE tssettimestep
1233 
1234  SUBROUTINE tssettype(ts,tstype,ierr)
1235  ts ts
1236  tstype tstype
1237  petscint ierr
1238  END SUBROUTINE tssettype
1239 
1240  SUBROUTINE tssolve(ts,x,ftime,ierr)
1241  ts ts
1242  vec x
1243  petscreal ftime
1244  petscint ierr
1245  END SUBROUTINE tssolve
1246 
1247  SUBROUTINE tsstep(ts,steps,ptime,ierr)
1248  ts ts
1249  petscint steps
1250  petscreal ptime
1251  petscint ierr
1252  END SUBROUTINE tsstep
1253 
1254  SUBROUTINE tssundialssettolerance(ts,abstol,reltol,ierr)
1255  ts ts
1256  petscreal abstol
1257  petscreal reltol
1258  petscint ierr
1259  END SUBROUTINE tssundialssettolerance
1260 
1261  SUBROUTINE tssundialssettype(ts,sundialstype,ierr)
1262  ts ts
1263  tssundialstype sundialstype
1264  petscint ierr
1265  END SUBROUTINE tssundialssettype
1266 
1267  !Vector routines
1268 
1269  SUBROUTINE vecassemblybegin(x,ierr)
1270  vec x
1271  petscint ierr
1272  END SUBROUTINE vecassemblybegin
1273 
1274  SUBROUTINE vecassemblyend(x,ierr)
1275  vec x
1276  petscint ierr
1277  END SUBROUTINE vecassemblyend
1278 
1279  SUBROUTINE veccopy(x,y,ierr)
1280  vec x
1281  vec y
1282  petscint ierr
1283  END SUBROUTINE veccopy
1284 
1285  SUBROUTINE veccreate(comm,x,ierr)
1286  mpi_comm comm
1287  vec x
1288  petscint ierr
1289  END SUBROUTINE veccreate
1290 
1291  SUBROUTINE veccreateghost(comm,localm,globalm,nghost,ghosts,x,ierr)
1292  mpi_comm comm
1293  petscint localm
1294  petscint globalm
1295  petscint nghost
1296  petscint ghosts(*)
1297  vec x
1298  petscint ierr
1299  END SUBROUTINE veccreateghost
1300 
1301  SUBROUTINE veccreateghostwitharray(comm,localm,globalm,nghost,ghosts,array,x,ierr)
1302  mpi_comm comm
1303  petscint localm
1304  petscint globalm
1305  petscint nghost
1306  petscint ghosts(*)
1307  petscscalar array(*)
1308  vec x
1309  petscint ierr
1310  END SUBROUTINE veccreateghostwitharray
1311 
1312  SUBROUTINE veccreatempi(comm,localm,globalm,x,ierr)
1313  mpi_comm comm
1314  petscint localm
1315  petscint globalm
1316  vec x
1317  petscint ierr
1318  END SUBROUTINE veccreatempi
1319 
1320  SUBROUTINE veccreatempiwitharray(comm,localn,globaln,array,x,ierr)
1321  mpi_comm comm
1322  petscint localn
1323  petscint globaln
1324  petscscalar array(*)
1325  vec x
1326  petscint ierr
1327  END SUBROUTINE veccreatempiwitharray
1328 
1329  SUBROUTINE veccreateseq(comm,m,x,ierr)
1330  mpi_comm comm
1331  petscint m
1332  vec x
1333  petscint ierr
1334  END SUBROUTINE veccreateseq
1335 
1336  SUBROUTINE veccreateseqwitharray(comm,n,array,x,ierr)
1337  mpi_comm comm
1338  petscint n
1339  petscscalar array(*)
1340  vec x
1341  petscint ierr
1342  END SUBROUTINE veccreateseqwitharray
1343 
1344  SUBROUTINE vecdestroy(x,ierr)
1345  vec x
1346  petscint ierr
1347  END SUBROUTINE vecdestroy
1348 
1349  SUBROUTINE vecduplicate(old,new,ierr)
1350  vec old,new
1351  petscint ierr
1352  END SUBROUTINE vecduplicate
1353 
1354  SUBROUTINE vecdot(x,y,val,ierr)
1355  vec x
1356  vec y
1357  petscscalar val
1358  petscint ierr
1359  END SUBROUTINE vecdot
1360 
1361  SUBROUTINE vecgetarrayf90(x,vec_data,ierr)
1362  vec x
1363  petscscalar, POINTER :: vec_data(:)
1364  petscint ierr
1365  END SUBROUTINE vecgetarrayf90
1366 
1367  SUBROUTINE vecgetarrayreadf90(x,vec_data,ierr)
1368  vec x
1369  petscscalar, POINTER :: vec_data(:)
1370  petscint ierr
1371  END SUBROUTINE vecgetarrayreadf90
1372 
1373  SUBROUTINE vecgetlocalsize(x,size,ierr)
1374  vec x
1375  petscint size
1376  petscint ierr
1377  END SUBROUTINE vecgetlocalsize
1378 
1379  SUBROUTINE vecgetownershiprange(x,low,high,ierr)
1380  vec x
1381  petscint low
1382  petscint high
1383  petscint ierr
1384  END SUBROUTINE vecgetownershiprange
1385 
1386  SUBROUTINE vecgetsize(x,size,ierr)
1387  vec x
1388  petscint size
1389  petscint ierr
1390  END SUBROUTINE vecgetsize
1391 
1392  SUBROUTINE vecgetvalues(x,n,indices,values,ierr)
1393  vec x
1394  petscint n
1395  petscint indices(*)
1396  petscscalar values(*)
1397  petscint ierr
1398  END SUBROUTINE vecgetvalues
1399 
1400  SUBROUTINE vecghostgetlocalform(g,l,ierr)
1401  vec g
1402  vec l
1403  petscint ierr
1404  END SUBROUTINE vecghostgetlocalform
1405 
1406  SUBROUTINE vecghostrestorelocalform(g,l,ierr)
1407  vec g
1408  vec l
1409  petscint ierr
1410  END SUBROUTINE vecghostrestorelocalform
1411 
1412  SUBROUTINE vecghostupdatebegin(x,insertmode,scattermode,ierr)
1413  vec x
1414  insertmode insertmode
1415  scattermode scattermode
1416  petscint ierr
1417  END SUBROUTINE vecghostupdatebegin
1418 
1419  SUBROUTINE vecghostupdateend(x,insertmode,scattermode,ierr)
1420  vec x
1421  insertmode insertmode
1422  scattermode scattermode
1423  petscint ierr
1424  END SUBROUTINE vecghostupdateend
1425 
1426  SUBROUTINE vecnorm(x,ntype,val,ierr)
1427  vec x
1428  normtype ntype
1429  petscreal val
1430  petscint ierr
1431  END SUBROUTINE vecnorm
1432 
1433  SUBROUTINE vecrestorearrayf90(x,vec_data,ierr)
1434  vec x
1435  petscscalar, POINTER :: vec_data(:)
1436  petscint ierr
1437  END SUBROUTINE vecrestorearrayf90
1438 
1439  SUBROUTINE vecrestorearrayreadf90(x,vec_data,ierr)
1440  vec x
1441  petscscalar, POINTER :: vec_data(:)
1442  petscint ierr
1443  END SUBROUTINE vecrestorearrayreadf90
1444 
1445  SUBROUTINE vecscale(x,alpha,ierr)
1446  vec x
1447  petscscalar alpha
1448  petscint ierr
1449  END SUBROUTINE vecscale
1450 
1451  SUBROUTINE vecset(x,value,ierr)
1452  vec x
1453  petscscalar value
1454  petscint ierr
1455  END SUBROUTINE vecset
1456 
1457  SUBROUTINE vecsetfromoptions(x,ierr)
1458  vec x
1459  petscint ierr
1460  END SUBROUTINE vecsetfromoptions
1461 
1462  SUBROUTINE vecsetlocaltoglobalmapping(v,ctx,ierr)
1463  vec v
1464  islocaltoglobalmapping ctx
1465  petscint ierr
1466  END SUBROUTINE vecsetlocaltoglobalmapping
1467 
1468  SUBROUTINE vecsetsizes(x,localm,globalm,ierr)
1469  vec x
1470  petscint localm,globalm
1471  petscint ierr
1472  END SUBROUTINE vecsetsizes
1473 
1474  SUBROUTINE vecsetvalues(x,n,indices,values,insertmode,ierr)
1475  vec x
1476  petscint n
1477  petscint indices(*)
1478  petscscalar values(*)
1479  insertmode insertmode
1480  petscint ierr
1481  END SUBROUTINE vecsetvalues
1482 
1483  SUBROUTINE vecsetvalueslocal(x,n,indices,values,insertmode,ierr)
1484  vec x
1485  petscint n
1486  petscint indices(*)
1487  petscscalar values(*)
1488  insertmode insertmode
1489  petscint ierr
1490  END SUBROUTINE vecsetvalueslocal
1491 
1492  SUBROUTINE vecview(x,v,ierr)
1493  vec x
1494  petscviewer v
1495  petscint ierr
1496  END SUBROUTINE vecview
1497 
1498  END INTERFACE
1499 
1501  MODULE PROCEDURE petsc_snesgetjacobiansolver
1502  MODULE PROCEDURE petsc_snesgetjacobianspecial
1503  END INTERFACE petsc_snesgetjacobian
1504 
1506  MODULE PROCEDURE petsc_snessetjacobiansolver
1507  END INTERFACE petsc_snessetjacobian
1508 
1509  !Miscelaneous routines and constants
1510 
1511  PUBLIC petsc_true,petsc_false
1512 
1513  PUBLIC petsc_null_bool,petsc_null_character,petsc_null_function,petsc_null_integer,petsc_null_double,petsc_null_object, &
1514  & petsc_null_scalar,petsc_null_real
1515 
1516  PUBLIC petsc_default_integer,petsc_default_real
1517 
1518  PUBLIC petsc_decide
1519 
1520  PUBLIC petsc_comm_world,petsc_comm_self
1521 
1522  PUBLIC petsc_viewer_stdout_world,petsc_viewer_stdout_self,petsc_viewer_draw_world,petsc_viewer_draw_self
1523 
1525 
1527 
1528  PUBLIC petsc_logview
1529 
1530  !Value insert constants
1531 
1532  PUBLIC petsc_add_values,petsc_insert_values
1533 
1534  PUBLIC petsc_scatter_forward,petsc_scatter_reverse
1535 
1536  !Norm constants
1537 
1538  PUBLIC petsc_norm_1,petsc_norm_2,petsc_norm_infinity
1539 
1540  !IS routines
1541 
1543 
1544  PUBLIC petsc_isdestroy
1545 
1546  !IS coloring routines
1547 
1549 
1551 
1552  !IS local to global mapping routines
1553 
1555 
1558 
1559  !KSP routines and constants
1560 
1561  PUBLIC petsc_ksprichardson,petsc_kspchebyshev,petsc_kspcg,petsc_kspcgne,petsc_kspnash,petsc_kspstcg,petsc_kspgltr, &
1562  & petsc_kspgmres,petsc_kspfgmres,petsc_ksplgmres,petsc_kspdgmres,petsc_ksppgmres,petsc_ksptcqmr,petsc_kspbcgs, &
1563  & petsc_kspibcgs,petsc_kspfbcgs,petsc_kspfbcgsr,petsc_kspbcgsl,petsc_kspcgs,petsc_ksptfqmr,petsc_kspcr,petsc_ksplsqr, &
1564  & petsc_ksppreonly,petsc_kspqcg,petsc_kspbicg,petsc_kspminres,petsc_kspsymmlq,petsc_ksplcd,petsc_ksppython,petsc_kspgcr
1565 
1566  PUBLIC petsc_ksp_converged_rtol,petsc_ksp_converged_atol,petsc_ksp_converged_its,petsc_ksp_converged_iterating, &
1567  & petsc_ksp_converged_cg_neg_curve,petsc_ksp_converged_cg_constrained,petsc_ksp_converged_step_length, &
1568  & petsc_ksp_converged_happy_breakdown,petsc_ksp_diverged_null,petsc_ksp_diverged_its,petsc_ksp_diverged_dtol, &
1569  & petsc_ksp_diverged_breakdown,petsc_ksp_diverged_breakdown_bicg,petsc_ksp_diverged_nonsymmetric, &
1570  & petsc_ksp_diverged_indefinite_pc,petsc_ksp_diverged_nanorinf,petsc_ksp_diverged_indefinite_mat
1571 
1572  PUBLIC petsc_ksp_norm_none,petsc_ksp_norm_preconditioned,petsc_ksp_norm_unpreconditioned,petsc_ksp_norm_natural
1573 
1575 
1579  & petsc_kspsolve
1580 
1581  !Matrix routines and constants
1582 
1583  PUBLIC petsc_mat_flush_assembly,petsc_mat_final_assembly
1584 
1585  PUBLIC petsc_mat_do_not_copy_values,petsc_mat_copy_values,petsc_mat_share_nonzero_pattern
1586 
1587  PUBLIC petsc_mat_info_size,petsc_mat_info_block_size,petsc_mat_info_nz_allocated,petsc_mat_info_nz_used, &
1588  & petsc_mat_info_nz_unneeded,petsc_mat_info_memory,petsc_mat_info_assemblies,petsc_mat_info_mallocs, &
1589  & petsc_mat_info_fill_ratio_given,petsc_mat_info_fill_ratio_needed,petsc_mat_info_factor_mallocs
1590 
1591  PUBLIC petsc_mat_local,petsc_mat_global_max,petsc_mat_global_sum
1592 
1593  PUBLIC petsc_mat_row_oriented,petsc_mat_new_nonzero_locations,petsc_mat_symmetric,petsc_mat_structurally_symmetric, &
1594  & petsc_mat_new_diagonals,petsc_mat_ignore_off_proc_entries,petsc_mat_new_nonzero_location_err, &
1595  & petsc_mat_new_nonzero_allocation_err,petsc_mat_use_hash_table,petsc_mat_keep_nonzero_pattern, &
1596  & petsc_mat_ignore_zero_entries,petsc_mat_use_inodes,petsc_mat_hermitian,petsc_mat_symmetry_eternal, &
1597  & petsc_mat_dummy,petsc_mat_ignore_lower_triangular,petsc_mat_error_lower_triangular,petsc_mat_getrow_uppertriangular, &
1598  & petsc_mat_unused_nonzero_location_err,petsc_mat_spd,petsc_mat_no_off_proc_entries,petsc_mat_no_off_proc_zero_rows
1599 
1600  PUBLIC petsc_mat_solver_superlu,petsc_mat_solver_superlu_dist,petsc_mat_solver_umfpack,petsc_mat_solver_cholmod, &
1601  & petsc_mat_solver_essl,petsc_mat_solver_lusol,petsc_mat_solver_mumps,petsc_mat_solver_pastix,petsc_mat_solver_matlab, &
1602  & petsc_mat_solver_petsc,petsc_mat_solver_bas,petsc_mat_solver_cusparse,petsc_mat_solver_bstrm,petsc_mat_solver_sbstrm
1603 
1604  PUBLIC petsc_different_nonzero_pattern,petsc_subset_nonzero_pattern,petsc_same_nonzero_pattern
1605 
1606  PUBLIC petsc_mat_initial_matrix,petsc_mat_reuse_matrix,petsc_mat_ignore_matrix
1607 
1609 
1617 
1618  !Matrix coloring routines and constants
1619  PUBLIC petsc_matcoloring_natural,petsc_matcoloring_sl,petsc_matcoloring_lf,petsc_matcoloring_id,petsc_matcoloring_greedy, &
1620  & petsc_matcoloring_jp
1621 
1623 
1626 
1627  !Matrix FD coloring routines and constants
1628 
1630 
1633 
1634  !Pre-conditioner routines and constants
1635 
1636  PUBLIC petsc_pcnone,petsc_pcjacobi,petsc_pcsor,petsc_pclu,petsc_pcshell,petsc_pcbjacobi,petsc_pcmg,petsc_pceisenstat, &
1637  & petsc_pcilu,petsc_pcicc,petsc_pcasm,petsc_pcksp,petsc_pccomposite,petsc_pcredundant,petsc_pcspai,petsc_pcnn, &
1638  & petsc_pccholesky,petsc_pcpbjacobi,petsc_pcmat,petsc_pchypre,petsc_pcparms,petsc_pcfieldsplit,petsc_pctfs,petsc_pcml, &
1639  & petsc_pcgalerkin,petsc_pcexotic,petsc_pcsupportgraph,petsc_pccp,petsc_pcbfbt,petsc_pclsc,petsc_pcpython,petsc_pcpfmg, &
1640  & petsc_pcsyspfmg,petsc_pcredistribute,petsc_pcsvd,petsc_pcgamg,petsc_pcgasm,petsc_pcsacusp,petsc_pcsacusppoly, &
1641  & petsc_pcbicgstabcusp,petsc_pcainvcusp,petsc_pcbddc
1642 
1644 
1647 
1648  !SNES routines and constants
1649 
1650  PUBLIC petsc_snesnewtonls,petsc_snesnewtontr,petsc_snespython,petsc_snestest,petsc_snesnrichardson,petsc_snesksponly, &
1651  & petsc_snesvinewtonrsls,petsc_snesvinewtonssls,petsc_snesngmres,petsc_snesqn,petsc_snesshell,petsc_snesncg,petsc_snesfas, &
1652  & petsc_snesms
1653 
1654  PUBLIC petsc_snes_converged_fnorm_abs,petsc_snes_converged_fnorm_relative,petsc_snes_converged_snorm_relative, &
1655  & petsc_snes_converged_its,petsc_snes_converged_tr_delta,petsc_snes_diverged_function_domain, &
1656  & petsc_snes_diverged_function_count,petsc_snes_diverged_linear_solve,petsc_snes_diverged_fnorm_nan, &
1657  & petsc_snes_diverged_max_it,petsc_snes_diverged_line_search,petsc_snes_diverged_local_min,petsc_snes_converged_iterating
1658 
1659  PUBLIC petsc_snes_norm_default,petsc_snes_norm_none,petsc_snes_norm_always,petsc_snes_norm_initial_only, &
1660  & petsc_snes_norm_final_only,petsc_snes_norm_initial_final_only
1661 
1662  PUBLIC petsc_snes_qn_lbfgs,petsc_snes_qn_broyden,petsc_snes_qn_badbroyden
1663 
1664  PUBLIC petsc_snes_qn_restart_none,petsc_snes_qn_restart_powell,petsc_snes_qn_restart_periodic
1665 
1666  PUBLIC petsc_snes_qn_scale_default,petsc_snes_qn_scale_none,petsc_snes_qn_scale_shanno,petsc_snes_qn_scale_linesearch, &
1667  & petsc_snes_qn_scale_jacobian
1668 
1670 
1672 
1679 
1680  !SNES line search routines and constants
1681 
1682  PUBLIC petsc_snes_linesearch_basic,petsc_snes_linesearch_bt,petsc_snes_linesearch_l2,petsc_snes_linesearch_cp, &
1683  & petsc_snes_linesearch_shell
1684 
1685  PUBLIC petsc_snes_linesearch_order_linear,petsc_snes_linesearch_order_quadratic,petsc_snes_linesearch_order_cubic
1686 
1688 
1692 
1693  !TS routines and constants
1694 
1695  PUBLIC petsc_ts_euler,petsc_ts_beuler,petsc_ts_pseudo,petsc_ts_cn,petsc_ts_sundials,petsc_ts_rk,petsc_ts_python, &
1696  & petsc_ts_theta,petsc_ts_alpha,petsc_ts_gl,petsc_ts_ssp,petsc_ts_arkimex,petsc_ts_rosw,petsc_ts_eimex
1697 
1698  PUBLIC petsc_ts_converged_iterating,petsc_ts_converged_time,petsc_ts_converged_its,petsc_ts_diverged_nonlinear_solve, &
1699  & petsc_ts_diverged_step_rejected
1700 
1701  PUBLIC petsc_ts_linear,petsc_ts_nonlinear
1702 
1703  PUBLIC petsc_sundials_adams,petsc_sundials_bdf
1704 
1705  PUBLIC petsc_sundials_modified_gs,petsc_sundials_classical_gs
1706 
1708 
1712 
1713  !Vector routines and constants
1714 
1716 
1723 
1724 CONTAINS
1725 
1726  !
1727  !================================================================================================================================
1728  !
1729 
1731  SUBROUTINE petsc_errorhandlingsetoff(err,error,*)
1733  !Argument Variables
1734  INTEGER(INTG), INTENT(OUT) :: err
1735  TYPE(varying_string), INTENT(OUT) :: error
1736  !Local Variables
1737 
1738  enters("Petsc_ErrorHandlingSetOff",err,error,*999)
1739 
1740  petschandleerror=.false.
1741 
1742  exits("Petsc_ErrorHandlingSetOff")
1743  RETURN
1744 999 errorsexits("Petsc_ErrorHandlingSetOff",err,error)
1745  RETURN 1
1746 
1747  END SUBROUTINE petsc_errorhandlingsetoff
1748 
1749  !
1750  !================================================================================================================================
1751  !
1752 
1754  SUBROUTINE petsc_errorhandlingseton(err,error,*)
1756  !Argument Variables
1757  INTEGER(INTG), INTENT(OUT) :: err
1758  TYPE(varying_string), INTENT(OUT) :: error
1759  !Local Variables
1760 
1761  enters("Petsc_ErrorHandlingSetOn",err,error,*999)
1762 
1763  petschandleerror=.true.
1764 
1765  exits("Petsc_ErrorHandlingSetOn")
1766  RETURN
1767 999 errorsexits("Petsc_ErrorHandlingSetOn",err,error)
1768  RETURN 1
1769  END SUBROUTINE petsc_errorhandlingseton
1770 
1771  !
1772  !================================================================================================================================
1773  !
1774 
1776  SUBROUTINE petsc_finalise(err,error,*)
1778  !Argument Variables
1779  INTEGER(INTG), INTENT(OUT) :: err
1780  TYPE(varying_string), INTENT(OUT) :: error
1781  !Local Variables
1782 
1783  enters("Petsc_Finalise",err,error,*999)
1784 
1785  CALL petscfinalize(err)
1786  IF(err/=0) THEN
1787  IF(petschandleerror) THEN
1788  chkerrq(err)
1789  ENDIF
1790  CALL flagerror("PETSc error in PetscFinalize.",err,error,*999)
1791  ENDIF
1792 
1793  exits("Petsc_Finalise")
1794  RETURN
1795 999 errorsexits("Petsc_Finalise",err,error)
1796  RETURN 1
1797 
1798  END SUBROUTINE petsc_finalise
1799 
1800  !
1801  !================================================================================================================================
1802  !
1803 
1805  SUBROUTINE petsc_initialise(file,err,error,*)
1807  !Argument Variables
1808  CHARACTER(LEN=*), INTENT(IN) :: file
1809  INTEGER(INTG), INTENT(OUT) :: err
1810  TYPE(varying_string), INTENT(OUT) :: error
1811  !Local Variables
1812 
1813  enters("Petsc_Initialise",err,error,*999)
1814 
1815  petschandleerror=.true.
1816  CALL petscinitialize(file,err)
1817  IF(err/=0) THEN
1818  IF(petschandleerror) THEN
1819  chkerrq(err)
1820  ENDIF
1821  CALL flagerror("PETSc error in PetscInitialize.",err,error,*999)
1822  ENDIF
1823  ! Disable PETSc's signal handler as we have our own OpenCMISS signal handlers in cmiss_c.c
1824  CALL petscpopsignalhandler(err)
1825  IF(err/=0) THEN
1826  IF(petschandleerror) THEN
1827  chkerrq(err)
1828  ENDIF
1829  CALL flagerror("PETSc error in PetscPopSignalHandler.",err,error,*999)
1830  ENDIF
1831 
1832  exits("Petsc_Initialise")
1833  RETURN
1834 999 errorsexits("Petsc_Initialise",err,error)
1835  RETURN 1
1836 
1837  END SUBROUTINE petsc_initialise
1838 
1839  !
1840  !================================================================================================================================
1841  !
1842 
1844  SUBROUTINE petsc_logview(viewer,err,error,*)
1846  !Argument Variables
1847  petscviewer, INTENT(IN) :: viewer
1848  INTEGER(INTG), INTENT(OUT) :: err
1849  TYPE(varying_string), INTENT(OUT) :: error
1850  !Local Variables
1851 
1852  enters("Petsc_LogView",err,error,*999)
1853 
1854  CALL petsclogview(viewer,err)
1855  IF(err/=0) THEN
1856  IF(petschandleerror) THEN
1857  chkerrq(err)
1858  ENDIF
1859  CALL flagerror("PETSc error in PetscLogView.",err,error,*999)
1860  ENDIF
1861 
1862  exits("Petsc_LogView")
1863  RETURN
1864 999 errorsexits("Petsc_LogView",err,error)
1865  RETURN 1
1866 
1867  END SUBROUTINE petsc_logview
1868 
1869  !
1870  !================================================================================================================================
1871  !
1872 
1873  !Finalise the PETSc IS structure and destroy the IS
1874  SUBROUTINE petsc_isfinalise(is,err,error,*)
1876  !Argument Variables
1877  TYPE(petscistype), INTENT(INOUT) :: is
1878  INTEGER(INTG), INTENT(OUT) :: err
1879  TYPE(varying_string), INTENT(OUT) :: error
1880  !Local Variables
1881 
1882  enters("Petsc_ISFinalise",err,error,*999)
1883 
1884  IF(is%is/=petsc_null_object) THEN
1885  CALL petsc_isdestroy(is,err,error,*999)
1886  ENDIF
1887 
1888  exits("Petsc_ISFinalise")
1889  RETURN
1890 999 errorsexits("Petsc_ISFinalise",err,error)
1891  RETURN 1
1892 
1893  END SUBROUTINE petsc_isfinalise
1894 
1895  !
1896  !================================================================================================================================
1897  !
1898 
1899  !Initialise the PETSc IS structure
1900  SUBROUTINE petsc_isinitialise(is,err,error,*)
1902  !Argument Variables
1903  TYPE(petscistype), INTENT(INOUT) :: is
1904  INTEGER(INTG), INTENT(OUT) :: err
1905  TYPE(varying_string), INTENT(OUT) :: error
1906  !Local Variables
1907 
1908  enters("Petsc_ISInitialise",err,error,*999)
1909 
1910  is%is=petsc_null_object
1911 
1912  exits("Petsc_ISInitialise")
1913  RETURN
1914 999 errorsexits("Petsc_ISInitialise",err,error)
1915  RETURN 1
1916 
1917  END SUBROUTINE petsc_isinitialise
1918 
1919  !
1920  !================================================================================================================================
1921  !
1922 
1924  SUBROUTINE petsc_isdestroy(is,err,error,*)
1926  !Argument Variables
1927  TYPE(petscistype), INTENT(INOUT) :: is
1928  INTEGER(INTG), INTENT(OUT) :: err
1929  TYPE(varying_string), INTENT(OUT) :: error
1930  !Local Variables
1931 
1932  enters("Petsc_ISDestroy",err,error,*999)
1933 
1934  CALL isdestroy(is%is,err)
1935  IF(err/=0) THEN
1936  IF(petschandleerror) THEN
1937  chkerrq(err)
1938  ENDIF
1939  CALL flagerror("PETSc error in ISDestroy.",err,error,*999)
1940  ENDIF
1941  is%is=petsc_null_object
1942 
1943  exits("Petsc_ISDestroy")
1944  RETURN
1945 999 errorsexits("Petsc_ISDestroy",err,error)
1946  RETURN 1
1947 
1948  END SUBROUTINE petsc_isdestroy
1949 
1950  !
1951  !
1952  !================================================================================================================================
1953  !
1954 
1955  !Finalise the PETSc ISColoring structure and destroy the ISColoring
1956  SUBROUTINE petsc_iscoloringfinalise(iscoloring,err,error,*)
1958  !Argument Variables
1959  TYPE(petsciscoloringtype), INTENT(INOUT) :: iscoloring
1960  INTEGER(INTG), INTENT(OUT) :: err
1961  TYPE(varying_string), INTENT(OUT) :: error
1962  !Local Variables
1963 
1964  enters("Petsc_ISColoringFinalise",err,error,*999)
1965 
1966  IF(iscoloring%iscoloring/=petsc_null_object) THEN
1967  CALL petsc_iscoloringdestroy(iscoloring,err,error,*999)
1968  ENDIF
1969 
1970  exits("Petsc_ISColoringFinalise")
1971  RETURN
1972 999 errorsexits("Petsc_ISColoringFinalise",err,error)
1973  RETURN 1
1974 
1975  END SUBROUTINE petsc_iscoloringfinalise
1976 
1977  !
1978  !================================================================================================================================
1979  !
1980 
1981  !Initialise the PETSc ISColoring structure
1982  SUBROUTINE petsc_iscoloringinitialise(iscoloring,err,error,*)
1984  !Argument Variables
1985  TYPE(petsciscoloringtype), INTENT(INOUT) :: iscoloring
1986  INTEGER(INTG), INTENT(OUT) :: err
1987  TYPE(varying_string), INTENT(OUT) :: error
1988  !Local Variables
1989 
1990  enters("Petsc_ISColoringInitialise",err,error,*999)
1991 
1992  iscoloring%iscoloring=petsc_null_object
1993 
1994  exits("Petsc_ISColoringInitialise")
1995  RETURN
1996 999 errorsexits("Petsc_ISColoringInitialise",err,error)
1997  RETURN 1
1998 
1999  END SUBROUTINE petsc_iscoloringinitialise
2000 
2001  !
2002  !================================================================================================================================
2003  !
2004 
2006  SUBROUTINE petsc_iscoloringdestroy(iscoloring,err,error,*)
2008  !Argument Variables
2009  TYPE(petsciscoloringtype), INTENT(INOUT) :: iscoloring
2010  INTEGER(INTG), INTENT(OUT) :: err
2011  TYPE(varying_string), INTENT(OUT) :: error
2012  !Local Variables
2013 
2014  enters("Petsc_ISColoringDestroy",err,error,*999)
2015 
2016  CALL iscoloringdestroy(iscoloring%iscoloring,err)
2017  IF(err/=0) THEN
2018  IF(petschandleerror) THEN
2019  chkerrq(err)
2020  ENDIF
2021  CALL flagerror("PETSc error in ISColoringDestroy.",err,error,*999)
2022  ENDIF
2023  iscoloring%iscoloring=petsc_null_object
2024 
2025  exits("Petsc_ISColoringDestroy")
2026  RETURN
2027 999 errorsexits("Petsc_ISColoringDestroy",err,error)
2028  RETURN 1
2029 
2030  END SUBROUTINE petsc_iscoloringdestroy
2031 
2032  !
2033  !================================================================================================================================
2034  !
2035 
2036  !Finalise the PETSc ISLocalToGlobalMapping structure and destroy the ISLocalToGlobalMapping
2037  SUBROUTINE petsc_islocaltoglobalmappingfinalise(isLocalToGlobalMapping,err,error,*)
2039  !Argument Variables
2040  TYPE(petscislocaltogloabalmappingtype), INTENT(INOUT) :: isLocalToGlobalMapping
2041  INTEGER(INTG), INTENT(OUT) :: err
2042  TYPE(varying_string), INTENT(OUT) :: error
2043  !Local Variables
2044 
2045  enters("Petsc_ISLocalToGlobalMappingFinalise",err,error,*999)
2046 
2047  IF(islocaltoglobalmapping%isLocalToGlobalMapping/=petsc_null_object) THEN
2048  CALL petsc_islocaltoglobalmappingdestroy(islocaltoglobalmapping,err,error,*999)
2049  ENDIF
2050 
2051  exits("Petsc_ISLocalToGlobalMappingFinalise")
2052  RETURN
2053 999 errorsexits("Petsc_ISLocalToGlobalMappingFinalise",err,error)
2054  RETURN 1
2055 
2057 
2058  !
2059  !================================================================================================================================
2060  !
2061 
2062  !Initialise the PETSc ISLocalToGlobalMapping structure
2063  SUBROUTINE petsc_islocaltoglobalmappinginitialise(isLocalToGlobalMapping,err,error,*)
2065  !Argument Variables
2066  TYPE(petscislocaltogloabalmappingtype), INTENT(INOUT) :: isLocalToGlobalMapping
2067  INTEGER(INTG), INTENT(OUT) :: err
2068  TYPE(varying_string), INTENT(OUT) :: error
2069  !Local Variables
2070 
2071  enters("Petsc_ISLocalToGlobalMappingInitialise",err,error,*999)
2072 
2073  islocaltoglobalmapping%isLocalToGlobalMapping=petsc_null_object
2074 
2075  exits("Petsc_ISLocalToGlobalMappingInitialise")
2076  RETURN
2077 999 errorsexits("Petsc_ISLocalToGlobalMappingInitialise",err,error)
2078  RETURN 1
2079 
2081 
2082  !
2083  !================================================================================================================================
2084  !
2085 
2087  SUBROUTINE petsc_islocaltoglobalmappingapply(isLocalToGlobalMapping,n,idxIn,idxOut,err,error,*)
2089  !Argument Variables
2090  TYPE(petscislocaltogloabalmappingtype), INTENT(INOUT) :: isLocalToGlobalMapping
2091  INTEGER(INTG), INTENT(IN) :: n
2092  INTEGER(INTG), INTENT(IN) :: idxIn(:)
2093  INTEGER(INTG), INTENT(OUT) :: idxOut(:)
2094  INTEGER(INTG), INTENT(OUT) :: err
2095  TYPE(varying_string), INTENT(OUT) :: error
2096  !Local Variables
2097 
2098  enters("Petsc_ISLocalToGlobalMappingApply",err,error,*999)
2099 
2100  CALL islocaltoglobalmappingapply(islocaltoglobalmapping%isLocalToGlobalMapping,n,idxin,idxout,err)
2101  IF(err/=0) THEN
2102  IF(petschandleerror) THEN
2103  chkerrq(err)
2104  ENDIF
2105  CALL flagerror("PETSc error in ISLocalToGlobalMappingApply.",err,error,*999)
2106  ENDIF
2107  islocaltoglobalmapping%isLocalToGlobalMapping=petsc_null_object
2108 
2109  exits("Petsc_ISLocalToGlobalMappingApply")
2110  RETURN
2111 999 errorsexits("Petsc_ISLocalToGlobalMappingApply",err,error)
2112  RETURN 1
2113 
2114  END SUBROUTINE petsc_islocaltoglobalmappingapply
2115 
2116  !
2117  !================================================================================================================================
2118  !
2119 
2121  SUBROUTINE petsc_islocaltoglobalmappingapplyis(isLocalToGlobalMapping,isIn,isOut,err,error,*)
2123  !Argument Variables
2124  TYPE(petscislocaltogloabalmappingtype), INTENT(IN) :: isLocalToGlobalMapping
2125  TYPE(petscistype), INTENT(IN) :: isIn
2126  TYPE(petscistype), INTENT(OUT) :: isOut
2127  INTEGER(INTG), INTENT(OUT) :: err
2128  TYPE(varying_string), INTENT(OUT) :: error
2129  !Local Variables
2130 
2131  enters("Petsc_ISLocalToGlobalMappingApplyIS",err,error,*999)
2132 
2133  CALL islocaltoglobalmappingapplyis(islocaltoglobalmapping%isLocalToGlobalMapping,isin%is,isout%is,err)
2134  IF(err/=0) THEN
2135  IF(petschandleerror) THEN
2136  chkerrq(err)
2137  ENDIF
2138  CALL flagerror("PETSc error in ISLocalToGlobalMappingApplyIS.",err,error,*999)
2139  ENDIF
2140 
2141  exits("Petsc_ISLocalToGlobalMappingApplyIS")
2142  RETURN
2143 999 errorsexits("Petsc_ISLocalToGlobalMappingApplyIS",err,error)
2144  RETURN 1
2145 
2147 
2148  !
2149  !================================================================================================================================
2150  !
2151 
2153  SUBROUTINE petsc_islocaltoglobalmappingcreate(communicator,blockSize,n,indices,mode,isLocalToGlobalMapping,err,error,*)
2155  !Argument Variables
2156  mpi_comm, INTENT(IN) :: communicator
2157  INTEGER(INTG), INTENT(IN) :: blockSize
2158  INTEGER(INTG), INTENT(IN) :: n
2159  INTEGER(INTG), INTENT(IN) :: indices(:)
2160  petsccopymode, INTENT(IN) :: mode
2161  TYPE(petscislocaltogloabalmappingtype), INTENT(INOUT) :: isLocalToGlobalMapping
2162  INTEGER(INTG), INTENT(OUT) :: err
2163  TYPE(varying_string), INTENT(OUT) :: error
2164  !Local Variables
2165 
2166  enters("Petsc_ISLocalToGlobalMappingCreate",err,error,*999)
2167 
2168  CALL islocaltoglobalmappingcreate(communicator,blocksize,n,indices,mode,islocaltoglobalmapping%isLocalToGlobalMapping,err)
2169  IF(err/=0) THEN
2170  IF(petschandleerror) THEN
2171  chkerrq(err)
2172  ENDIF
2173  CALL flagerror("PETSc error in ISLocalToGlobalMappingCreate.",err,error,*999)
2174  ENDIF
2175 
2176  exits("Petsc_ISLocalToGlobalMappingCreate")
2177  RETURN
2178 999 errorsexits("Petsc_ISLocalToGlobalMappingCreate",err,error)
2179  RETURN 1
2180 
2181  END SUBROUTINE petsc_islocaltoglobalmappingcreate
2182 
2183  !
2184  !================================================================================================================================
2185  !
2186 
2188  SUBROUTINE petsc_islocaltoglobalmappingdestroy(isLocalToGlobalMapping,err,error,*)
2190  !Argument Variables
2191  TYPE(petscislocaltogloabalmappingtype), INTENT(INOUT) :: isLocalToGlobalMapping
2192  INTEGER(INTG), INTENT(OUT) :: err
2193  TYPE(varying_string), INTENT(OUT) :: error
2194  !Local Variables
2195 
2196  enters("Petsc_ISLocalToGlobalMappingDestroy",err,error,*999)
2197 
2198  CALL islocaltoglobalmappingdestroy(islocaltoglobalmapping%isLocalToGlobalMapping,err)
2199  IF(err/=0) THEN
2200  IF(petschandleerror) THEN
2201  chkerrq(err)
2202  ENDIF
2203  CALL flagerror("PETSc error in ISLocalToGlobalMappingDestroy.",err,error,*999)
2204  ENDIF
2205  islocaltoglobalmapping%isLocalToGlobalMapping=petsc_null_object
2206 
2207  exits("Petsc_ISLocalToGlobalMappingDestroy")
2208  RETURN
2209 999 errorsexits("Petsc_ISLocalToGlobalMappingDestroy",err,error)
2210  RETURN 1
2211 
2213 
2214  !
2215  !================================================================================================================================
2216  !
2217 
2219  SUBROUTINE petsc_kspfinalise(ksp,err,error,*)
2221  !Argument Variables
2222  TYPE(petscksptype), INTENT(INOUT) :: ksp
2223  INTEGER(INTG), INTENT(OUT) :: err
2224  TYPE(varying_string), INTENT(OUT) :: error
2225  !Local Variables
2226 
2227  enters("Petsc_KSPFinalise",err,error,*999)
2228 
2229  IF(ksp%ksp/=petsc_null_object) THEN
2230  CALL petsc_kspdestroy(ksp,err,error,*999)
2231  ENDIF
2232 
2233  exits("Petsc_KSPFinalise")
2234  RETURN
2235 999 errorsexits("Petsc_KSPFinalise",err,error)
2236  RETURN 1
2237 
2238  END SUBROUTINE petsc_kspfinalise
2239 
2240  !
2241  !================================================================================================================================
2242  !
2243 
2245  SUBROUTINE petsc_kspinitialise(ksp,err,error,*)
2247  !Argument Variables
2248  TYPE(petscksptype), INTENT(INOUT) :: ksp
2249  INTEGER(INTG), INTENT(OUT) :: err
2250  TYPE(varying_string), INTENT(OUT) :: error
2251  !Local Variables
2252 
2253  enters("Petsc_KSPInitialise",err,error,*999)
2254 
2255  ksp%ksp=petsc_null_object
2256 
2257  exits("Petsc_KSPInitialise")
2258  RETURN
2259 999 errorsexits("Petsc_KSPInitialise",err,error)
2260  RETURN 1
2261 
2262  END SUBROUTINE petsc_kspinitialise
2263 
2264  !
2265  !================================================================================================================================
2266  !
2267 
2269  SUBROUTINE petsc_kspcreate(communicator,ksp,err,error,*)
2271  !Argument Variables
2272  mpi_comm, INTENT(IN) :: communicator
2273  TYPE(petscksptype), INTENT(INOUT) :: ksp
2274  INTEGER(INTG), INTENT(OUT) :: err
2275  TYPE(varying_string), INTENT(OUT) :: error
2276  !Local Variables
2277 
2278  enters("Petsc_KSPCreate",err,error,*999)
2279 
2280  CALL kspcreate(communicator,ksp%ksp,err)
2281  IF(err/=0) THEN
2282  IF(petschandleerror) THEN
2283  chkerrq(err)
2284  ENDIF
2285  CALL flagerror("PETSc error in KSPCreate.",err,error,*999)
2286  ENDIF
2287 
2288  exits("Petsc_KSPCreate")
2289  RETURN
2290 999 errorsexits("Petsc_KSPCreate",err,error)
2291  RETURN 1
2292 
2293  END SUBROUTINE petsc_kspcreate
2294 
2295  !
2296  !================================================================================================================================
2297  !
2298 
2300  SUBROUTINE petsc_kspdestroy(ksp,err,error,*)
2302  !Argument Variables
2303  TYPE(petscksptype), INTENT(INOUT) :: ksp
2304  INTEGER(INTG), INTENT(OUT) :: err
2305  TYPE(varying_string), INTENT(OUT) :: error
2306  !Local Variables
2307 
2308  enters("Petsc_KSPDestroy",err,error,*999)
2309 
2310  CALL kspdestroy(ksp%ksp,err)
2311  IF(err/=0) THEN
2312  IF(petschandleerror) THEN
2313  chkerrq(err)
2314  ENDIF
2315  CALL flagerror("PETSc error in KSPDestroy.",err,error,*999)
2316  ENDIF
2317  ksp%ksp=petsc_null_object
2318 
2319  exits("Petsc_KSPDestroy")
2320  RETURN
2321 999 errorsexits("Petsc_KSPDestroy",err,error)
2322  RETURN 1
2323 
2324  END SUBROUTINE petsc_kspdestroy
2325 
2326  !
2327  !================================================================================================================================
2328  !
2329 
2331  SUBROUTINE petsc_kspgetconvergedreason(ksp,reason,err,error,*)
2333  !Argument Variables
2334  TYPE(petscksptype), INTENT(INOUT) :: ksp
2335  INTEGER(INTG), INTENT(OUT) :: reason
2336  INTEGER(INTG), INTENT(OUT) :: err
2337  TYPE(varying_string), INTENT(OUT) :: error
2338  !Local Variables
2339 
2340  enters("Petsc_KSPGetConvergedReason",err,error,*999)
2341 
2342  CALL kspgetconvergedreason(ksp%ksp,reason,err)
2343  IF(err/=0) THEN
2344  IF(petschandleerror) THEN
2345  chkerrq(err)
2346  ENDIF
2347  CALL flagerror("PETSc error in KSPGetConvergedReason.",err,error,*999)
2348  ENDIF
2349 
2350  exits("Petsc_KSPGetConvergedReason")
2351  RETURN
2352 999 errorsexits("Petsc_KSPGetConvergedReason",err,error)
2353  RETURN 1
2354  END SUBROUTINE petsc_kspgetconvergedreason
2355 
2356  !
2357  !================================================================================================================================
2358  !
2359 
2361  SUBROUTINE petsc_kspgetiterationnumber(ksp,iterationNumber,err,error,*)
2363  !Argument Variables
2364  TYPE(petscksptype), INTENT(INOUT) :: ksp
2365  INTEGER(INTG), INTENT(OUT) :: iterationNumber
2366  INTEGER(INTG), INTENT(OUT) :: err
2367  TYPE(varying_string), INTENT(OUT) :: error
2368  !Local Variables
2369 
2370  enters("Petsc_KSPGetIterationNumber",err,error,*999)
2371 
2372  CALL kspgetiterationnumber(ksp%ksp,iterationnumber,err)
2373  IF(err/=0) THEN
2374  IF(petschandleerror) THEN
2375  chkerrq(err)
2376  ENDIF
2377  CALL flagerror("PETSc error in KSPGetIterationNumber.",err,error,*999)
2378  ENDIF
2379 
2380  exits("Petsc_KSPGetIterationNumber")
2381  RETURN
2382 999 errorsexits("Petsc_KSPGetIterationNumber",err,error)
2383  RETURN 1
2384 
2385  END SUBROUTINE petsc_kspgetiterationnumber
2386 
2387  !
2388  !================================================================================================================================
2389  !
2390 
2392  SUBROUTINE petsc_kspgetpc(ksp,pc,err,error,*)
2394  !Argument Variables
2395  TYPE(petscksptype), INTENT(INOUT) :: ksp
2396  TYPE(petscpctype), INTENT(INOUT) :: pc
2397  INTEGER(INTG), INTENT(OUT) :: err
2398  TYPE(varying_string), INTENT(OUT) :: error
2399  !Local Variables
2400 
2401  enters("Petsc_KSPGetPC",err,error,*999)
2402 
2403  CALL kspgetpc(ksp%ksp,pc%pc,err)
2404  IF(err/=0) THEN
2405  IF(petschandleerror) THEN
2406  chkerrq(err)
2407  ENDIF
2408  CALL flagerror("PETSc error in KSPGetPC.",err,error,*999)
2409  ENDIF
2410 
2411  exits("Petsc_KSPGetPC")
2412  RETURN
2413 999 errorsexits("Petsc_KSPGetPC",err,error)
2414  RETURN 1
2415 
2416  END SUBROUTINE petsc_kspgetpc
2417 
2418  !
2419  !================================================================================================================================
2420  !
2421 
2423  SUBROUTINE petsc_kspgetresidualnorm(ksp,residualNorm,err,error,*)
2425  !Argument Variables
2426  TYPE(petscksptype), INTENT(INOUT) :: ksp
2427  REAL(DP), INTENT(OUT) :: residualNorm
2428  INTEGER(INTG), INTENT(OUT) :: err
2429  TYPE(varying_string), INTENT(OUT) :: error
2430  !Local Variables
2431 
2432  enters("Petsc_KSPGetResidualNorm",err,error,*999)
2433 
2434  CALL kspgetresidualnorm(ksp%ksp,residualnorm,err)
2435  IF(err/=0) THEN
2436  IF(petschandleerror) THEN
2437  chkerrq(err)
2438  ENDIF
2439  CALL flagerror("PETSc error in KSPGetResidualNorm.",err,error,*999)
2440  ENDIF
2441 
2442  exits("Petsc_KSPGetResidualNorm")
2443  RETURN
2444 999 errorsexits("Petsc_KSPGetResidualNorm",err,error)
2445  RETURN 1
2446 
2447  END SUBROUTINE petsc_kspgetresidualnorm
2448 
2449  !
2450  !================================================================================================================================
2451  !
2452 
2454  SUBROUTINE petsc_kspgmressetrestart(ksp,restart,err,error,*)
2456  !Argument Variables
2457  TYPE(petscksptype), INTENT(INOUT) :: ksp
2458  INTEGER(INTG), INTENT(OUT) :: restart
2459  INTEGER(INTG), INTENT(OUT) :: err
2460  TYPE(varying_string), INTENT(OUT) :: error
2461  !Local Variables
2462 
2463  enters("Petsc_KSPGMRESSetRestart",err,error,*999)
2464 
2465  CALL kspgmressetrestart(ksp%ksp,restart,err)
2466  IF(err/=0) THEN
2467  IF(petschandleerror) THEN
2468  chkerrq(err)
2469  ENDIF
2470  CALL flagerror("PETSc error in KSPGMRESSetRestart.",err,error,*999)
2471  ENDIF
2472 
2473  exits("Petsc_KSPGMRESSetRestart")
2474  RETURN
2475 999 errorsexits("Petsc_KSPGMRESSetRestart",err,error)
2476  RETURN 1
2477 
2478  END SUBROUTINE petsc_kspgmressetrestart
2479 
2480  !
2481  !================================================================================================================================
2482  !
2483 
2485  SUBROUTINE petsc_kspsetfromoptions(ksp,err,error,*)
2487  !Argument Variables
2488  TYPE(petscksptype), INTENT(INOUT) :: ksp
2489  INTEGER(INTG), INTENT(OUT) :: err
2490  TYPE(varying_string), INTENT(OUT) :: error
2491  !Local Variables
2492 
2493  enters("Petsc_KSPSetFromOptions",err,error,*999)
2494 
2495  CALL kspsetfromoptions(ksp%ksp,err)
2496  IF(err/=0) THEN
2497  IF(petschandleerror) THEN
2498  chkerrq(err)
2499  ENDIF
2500  CALL flagerror("PETSc error in KSPSetFromOptions.",err,error,*999)
2501  ENDIF
2502 
2503  exits("Petsc_KSPSetFromOptions")
2504  RETURN
2505 999 errorsexits("Petsc_KSPSetFromOptions",err,error)
2506  RETURN 1
2507 
2508  END SUBROUTINE petsc_kspsetfromoptions
2509 
2510  !
2511  !================================================================================================================================
2512  !
2513 
2515  SUBROUTINE petsc_kspsetinitialguessnonzero(ksp,flag,err,error,*)
2517  !Argument Variables
2518  TYPE(petscksptype), INTENT(INOUT) :: ksp
2519  LOGICAL, INTENT(IN) :: flag
2520  INTEGER(INTG), INTENT(OUT) :: err
2521  TYPE(varying_string), INTENT(OUT) :: error
2522  !Local Variables
2523 
2524  enters("Petsc_KSPSetInitialGuessNonZero",err,error,*999)
2525 
2526  IF(flag) THEN
2527  CALL kspsetinitialguessnonzero(ksp%ksp,petsc_true,err)
2528  ELSE
2529  CALL kspsetinitialguessnonzero(ksp%ksp,petsc_false,err)
2530  ENDIF
2531  IF(err/=0) THEN
2532  IF(petschandleerror) THEN
2533  chkerrq(err)
2534  ENDIF
2535  CALL flagerror("PETSc error in KSPSetInitialGuessNonzero.",err,error,*999)
2536  ENDIF
2537 
2538  exits("Petsc_KSPSetInitialGuessNonZero")
2539  RETURN
2540 999 errorsexits("Petsc_KSPSetInitialGuessNonZero",err,error)
2541  RETURN 1
2542 
2543  END SUBROUTINE petsc_kspsetinitialguessnonzero
2544 
2545  !
2546  !================================================================================================================================
2547  !
2548 
2550  SUBROUTINE petsc_kspsetoperators(ksp,amat,pmat,err,error,*)
2552  !Argument Variables
2553  TYPE(petscksptype), INTENT(INOUT) :: ksp
2554  TYPE(petscmattype), INTENT(INOUT) :: amat
2555  TYPE(petscmattype), INTENT(INOUT) :: pmat
2556  INTEGER(INTG), INTENT(OUT) :: err
2557  TYPE(varying_string), INTENT(OUT) :: error
2558  !Local Variables
2559 
2560  enters("Petsc_KSPSetOperators",err,error,*999)
2561 
2562  CALL kspsetoperators(ksp%ksp,amat%mat,pmat%mat,err)
2563  IF(err/=0) THEN
2564  IF(petschandleerror) THEN
2565  chkerrq(err)
2566  ENDIF
2567  CALL flagerror("PETSc error in KSPSetFromOperators.",err,error,*999)
2568  ENDIF
2569 
2570  exits("Petsc_KSPSetOperators")
2571  RETURN
2572 999 errorsexits("Petsc_KSPSetOperators",err,error)
2573  RETURN 1
2574 
2575  END SUBROUTINE petsc_kspsetoperators
2576 
2577  !
2578  !================================================================================================================================
2579  !
2580 
2582  SUBROUTINE petsc_kspsetreusepreconditioner(ksp,flag,err,error,*)
2584  !Argument Variables
2585  TYPE(petscksptype), INTENT(INOUT) :: ksp
2586  LOGICAL, INTENT(IN) :: flag
2587  INTEGER(INTG), INTENT(OUT) :: err
2588  TYPE(varying_string), INTENT(OUT) :: error
2589  !Local Variables
2590 
2591  enters("Petsc_KSPSetReusePreconditioner",err,error,*999)
2592 
2593  IF(flag) THEN
2594  CALL kspsetreusepreconditioner(ksp%ksp,petsc_true,err)
2595  ELSE
2596  CALL kspsetreusepreconditioner(ksp%ksp,petsc_false,err)
2597  ENDIF
2598  IF(err/=0) THEN
2599  IF(petschandleerror) THEN
2600  chkerrq(err)
2601  ENDIF
2602  CALL flagerror("PETSc error in KSPSetReusePreconditioner.",err,error,*999)
2603  ENDIF
2604 
2605  exits("Petsc_KSPSetReusePreconditioner")
2606  RETURN
2607 999 errorsexits("Petsc_KSPSetReusePreconditioner",err,error)
2608  RETURN 1
2609 
2610  END SUBROUTINE petsc_kspsetreusepreconditioner
2611 
2612  !
2613  !================================================================================================================================
2614  !
2615 
2617  SUBROUTINE petsc_kspsettolerances(ksp,rTol,aTol,dTol,maxIterations,err,error,*)
2619  !Argument Variables
2620  TYPE(petscksptype), INTENT(INOUT) :: ksp
2621  REAL(DP), INTENT(IN) :: rTol
2622  REAL(DP), INTENT(IN) :: aTol
2623  REAL(DP), INTENT(IN) :: dTol
2624  INTEGER(INTG), INTENT(IN) :: maxIterations
2625  INTEGER(INTG), INTENT(OUT) :: err
2626  TYPE(varying_string), INTENT(OUT) :: error
2627  !Local Variables
2628 
2629  enters("Petsc_KSPSetTolerances",err,error,*999)
2630 
2631  CALL kspsettolerances(ksp%ksp,rtol,atol,dtol,maxiterations,err)
2632  IF(err/=0) THEN
2633  IF(petschandleerror) THEN
2634  chkerrq(err)
2635  ENDIF
2636  CALL flagerror("PETSc error in KSPSetTolerances.",err,error,*999)
2637  ENDIF
2638 
2639  exits("Petsc_KSPSetTolerances")
2640  RETURN
2641 999 errorsexits("Petsc_KSPSetTolerances",err,error)
2642  RETURN 1
2643 
2644  END SUBROUTINE petsc_kspsettolerances
2645 
2646  !
2647  !================================================================================================================================
2648  !
2649 
2651  SUBROUTINE petsc_kspsettype(ksp,method,err,error,*)
2653  !Argument Variables
2654  TYPE(petscksptype), INTENT(INOUT) :: ksp
2655  ksptype, INTENT(IN) :: method
2656  INTEGER(INTG), INTENT(OUT) :: err
2657  TYPE(varying_string), INTENT(OUT) :: error
2658  !Local Variables
2659 
2660  enters("Petsc_KSPSetType",err,error,*999)
2661 
2662  CALL kspsettype(ksp%ksp,method,err)
2663  IF(err/=0) THEN
2664  IF(petschandleerror) THEN
2665  chkerrq(err)
2666  ENDIF
2667  CALL flagerror("PETSc error in KSPSetType.",err,error,*999)
2668  ENDIF
2669 
2670  exits("Petsc_KSPSetType")
2671  RETURN
2672 999 errorsexits("Petsc_KSPSetType",err,error)
2673  RETURN 1
2674 
2675  END SUBROUTINE petsc_kspsettype
2676 
2677  !
2678  !================================================================================================================================
2679  !
2680 
2682  SUBROUTINE petsc_kspsetup(ksp,err,error,*)
2684  !Argument Variables
2685  TYPE(petscksptype), INTENT(INOUT) :: ksp
2686  INTEGER(INTG), INTENT(OUT) :: err
2687  TYPE(varying_string), INTENT(OUT) :: error
2688  !Local Variables
2689 
2690  enters("Petsc_KSPSetUp",err,error,*999)
2691 
2692  CALL kspsetup(ksp%ksp,err)
2693  IF(err/=0) THEN
2694  IF(petschandleerror) THEN
2695  chkerrq(err)
2696  ENDIF
2697  CALL flagerror("PETSc error in KSPSetUp.",err,error,*999)
2698  ENDIF
2699 
2700  exits("Petsc_KSPSetUp")
2701  RETURN
2702 999 errorsexits("Petsc_KSPSetUp",err,error)
2703  RETURN 1
2704 
2705  END SUBROUTINE petsc_kspsetup
2706 
2707  !
2708  !================================================================================================================================
2709  !
2710 
2712  SUBROUTINE petsc_kspsolve(ksp,b,x,err,error,*)
2714  !Argument Variables
2715  TYPE(petscksptype), INTENT(INOUT) :: ksp
2716  TYPE(petscvectype), INTENT(INOUT) :: b
2717  TYPE(petscvectype), INTENT(INOUT) :: x
2718  INTEGER(INTG), INTENT(OUT) :: err
2719  TYPE(varying_string), INTENT(OUT) :: error
2720  !Local Variables
2721 
2722  enters("Petsc_KSPSolve",err,error,*999)
2723 
2724  CALL kspsolve(ksp%ksp,b%vec,x%vec,err)
2725  IF(err/=0) THEN
2726  IF(petschandleerror) THEN
2727  chkerrq(err)
2728  ENDIF
2729  CALL flagerror("PETSc error in KSPSolve.",err,error,*999)
2730  ENDIF
2731 
2732  exits("Petsc_KSPSolve")
2733  RETURN
2734 999 errorsexits("Petsc_KSPSolve",err,error)
2735  RETURN 1
2736 
2737  END SUBROUTINE petsc_kspsolve
2738 
2739  !
2740  !================================================================================================================================
2741  !
2742 
2743  !Finalise the PETSc Mat structure
2744  SUBROUTINE petsc_matfinalise(a,err,error,*)
2746  !Argument Variables
2747  TYPE(petscmattype), INTENT(INOUT) :: a
2748  INTEGER(INTG), INTENT(OUT) :: err
2749  TYPE(varying_string), INTENT(OUT) :: error
2750  !Local Variables
2751 
2752  enters("Petsc_MatFinalise",err,error,*999)
2753 
2754  IF(a%mat/=petsc_null_object) THEN
2755  CALL petsc_matdestroy(a,err,error,*999)
2756  ENDIF
2757 
2758  exits("Petsc_MatFinalise")
2759  RETURN
2760 999 errorsexits("Petsc_MatFinalise",err,error)
2761  RETURN 1
2762 
2763  END SUBROUTINE petsc_matfinalise
2764 
2765  !
2766  !================================================================================================================================
2767  !
2768 
2769  !Initialise the PETSc Mat structure
2770  SUBROUTINE petsc_matinitialise(a,err,error,*)
2772  !Argument Variables
2773  TYPE(petscmattype), INTENT(INOUT) :: a
2774  INTEGER(INTG), INTENT(OUT) :: err
2775  TYPE(varying_string), INTENT(OUT) :: error
2776  !Local Variables
2777 
2778  enters("Petsc_MatInitialise",err,error,*999)
2779 
2780  a%mat=petsc_null_object
2781 
2782  exits("Petsc_MatInitialise")
2783  RETURN
2784 999 errorsexits("Petsc_MatInitialise",err,error)
2785  RETURN 1
2786 
2787  END SUBROUTINE petsc_matinitialise
2788 
2789  !
2790  !================================================================================================================================
2791  !
2792 
2794  SUBROUTINE petsc_matassemblybegin(A,assemblyType,err,error,*)
2796  !Argument Variables
2797  TYPE(petscmattype), INTENT(INOUT) :: A !The matrix to assemble
2798  matassemblytype, INTENT(IN) :: assemblytype
2799  INTEGER(INTG), INTENT(OUT) :: err
2800  TYPE(varying_string), INTENT(OUT) :: error
2801  !Local Variables
2802 
2803  enters("Petsc_MatAssemblyBegin",err,error,*999)
2804 
2805  CALL matassemblybegin(a%mat,assemblytype,err)
2806  IF(err/=0) THEN
2807  IF(petschandleerror) THEN
2808  chkerrq(err)
2809  ENDIF
2810  CALL flagerror("PETSc error in MatAssemblyBegin.",err,error,*999)
2811  ENDIF
2812 
2813  exits("Petsc_MatAssemblyBegin")
2814  RETURN
2815 999 errorsexits("Petsc_MatAssemblyBegin",err,error)
2816  RETURN 1
2817 
2818  END SUBROUTINE petsc_matassemblybegin
2819 
2820  !
2821  !================================================================================================================================
2822  !
2823 
2825  SUBROUTINE petsc_matassemblyend(A,assemblyType,err,error,*)
2827  !Argument Variables
2828  TYPE(petscmattype), INTENT(INOUT) :: A
2829  matassemblytype, INTENT(IN) :: assemblytype
2830  INTEGER(INTG), INTENT(OUT) :: err
2831  TYPE(varying_string), INTENT(OUT) :: error
2832  !Local Variables
2833 
2834  enters("Petsc_MatAssemblyEnd",err,error,*999)
2835 
2836  CALL matassemblyend(a%mat,assemblytype,err)
2837  IF(err/=0) THEN
2838  IF(petschandleerror) THEN
2839  chkerrq(err)
2840  ENDIF
2841  CALL flagerror("PETSc error in MatAssemblyEnd.",err,error,*999)
2842  ENDIF
2843 
2844  exits("Petsc_MatAssemblyEnd")
2845  RETURN
2846 999 errorsexits("Petsc_MatAssemblyEnd",err,error)
2847  RETURN 1
2848 
2849  END SUBROUTINE petsc_matassemblyend
2850 
2851  !
2852  !================================================================================================================================
2853  !
2854 
2856  SUBROUTINE petsc_matcreate(communicator,A,err,error,*)
2858  !Argument Variables
2859  mpi_comm, INTENT(IN) :: communicator
2860  TYPE(petscmattype), INTENT(INOUT) :: A
2861  INTEGER(INTG), INTENT(OUT) :: err
2862  TYPE(varying_string), INTENT(OUT) :: error
2863  !Local Variables
2864 
2865  enters("Petsc_MatCreate",err,error,*999)
2866 
2867  CALL matcreate(communicator,a%mat,err)
2868  IF(err/=0) THEN
2869  IF(petschandleerror) THEN
2870  chkerrq(err)
2871  ENDIF
2872  CALL flagerror("PETSc error in MatCreate.",err,error,*999)
2873  ENDIF
2874 
2875  exits("Petsc_MatCreate")
2876  RETURN
2877 999 errorsexits("Petsc_MatCreate",err,error)
2878  RETURN 1
2879 
2880  END SUBROUTINE petsc_matcreate
2881 
2882  !
2883  !================================================================================================================================
2884  !
2885 
2887  SUBROUTINE petsc_matcreateaij(communicator,localM,localN,globalM,globalN,diagNumberNonZerosPerRow,diagNumberNonZerosEachRow, &
2888  & offdiagnumbernonzerosperrow,offdiagnumbernonzeroseachrow,a,err,error,*)
2890  !Argument Variables
2891  mpi_comm, INTENT(IN) :: communicator
2892  INTEGER(INTG), INTENT(IN) :: localM
2893  INTEGER(INTG), INTENT(IN) :: localN
2894  INTEGER(INTG), INTENT(IN) :: globalM
2895  INTEGER(INTG), INTENT(IN) :: globalN
2896  INTEGER(INTG), INTENT(IN) :: diagNumberNonZerosPerRow
2897  INTEGER(INTG), INTENT(IN) :: diagNumberNonZerosEachRow(:)
2898  INTEGER(INTG), INTENT(IN) :: offDiagNumberNonZerosPerRow
2899  INTEGER(INTG), INTENT(IN) :: offDiagNumberNonZerosEachRow(:)
2900  TYPE(petscmattype), INTENT(INOUT) :: a
2901  INTEGER(INTG), INTENT(OUT) :: err
2902  TYPE(varying_string), INTENT(OUT) :: error
2903  !Local Variables
2904 
2905  enters("Petsc_MatCreateAIJ",err,error,*999)
2906 
2907  CALL matcreateaij(communicator,localm,localn,globalm,globaln,diagnumbernonzerosperrow,diagnumbernonzeroseachrow, &
2908  & offdiagnumbernonzerosperrow,offdiagnumbernonzeroseachrow,a%mat,err)
2909  IF(err/=0) THEN
2910  IF(petschandleerror) THEN
2911  chkerrq(err)
2912  ENDIF
2913  CALL flagerror("PETSc error in MatCreateAIJ.",err,error,*999)
2914  ENDIF
2915 
2916  exits("Petsc_MatCreateAIJ")
2917  RETURN
2918 999 errorsexits("Petsc_MatCreateAIJ",err,error)
2919  RETURN 1
2920 
2921  END SUBROUTINE petsc_matcreateaij
2922 
2923  !
2924  !================================================================================================================================
2925  !
2926 
2928  SUBROUTINE petsc_matcreatedense(communicator,localM,localN,globalM,globalN,matrixData,a,err,error,*)
2930  !Argument Variables
2931  mpi_comm, INTENT(IN) :: communicator
2932  INTEGER(INTG), INTENT(IN) :: localM
2933  INTEGER(INTG), INTENT(IN) :: localN
2934  INTEGER(INTG), INTENT(IN) :: globalM
2935  INTEGER(INTG), INTENT(IN) :: globalN
2936  REAL(DP), INTENT(IN) :: matrixData(:)
2937  TYPE(petscmattype), INTENT(INOUT) :: a
2938  INTEGER(INTG), INTENT(OUT) :: err
2939  TYPE(varying_string), INTENT(OUT) :: error
2940  !Local Variables
2941 
2942  enters("Petsc_MatCreateDense",err,error,*999)
2943 
2944  CALL matcreatedense(communicator,localm,localn,globalm,globaln,matrixdata,a%mat,err)
2945  IF(err/=0) THEN
2946  IF(petschandleerror) THEN
2947  chkerrq(err)
2948  ENDIF
2949  CALL flagerror("PETSc error in MatCreateDense.",err,error,*999)
2950  ENDIF
2951 
2952  exits("Petsc_MatCreateDense")
2953  RETURN
2954 999 errorsexits("Petsc_MatCreateDense",err,error)
2955  RETURN 1
2956 
2957  END SUBROUTINE petsc_matcreatedense
2958 
2959  !
2960  !================================================================================================================================
2961  !
2962 
2964  SUBROUTINE petsc_matcreateseqaij(communicator,m,n,numberNonZerosPerRow,numberNonZerosEachRow,a,err,error,*)
2966  !Argument Variables
2967  mpi_comm, INTENT(IN) :: communicator
2968  INTEGER(INTG), INTENT(IN) :: m
2969  INTEGER(INTG), INTENT(IN) :: n
2970  INTEGER(INTG), INTENT(IN) :: numberNonZerosPerRow
2971  INTEGER(INTG), INTENT(IN) :: numberNonZerosEachRow(:)
2972  TYPE(petscmattype), INTENT(INOUT) :: a
2973  INTEGER(INTG), INTENT(OUT) :: err
2974  TYPE(varying_string), INTENT(OUT) :: error
2975  !Local Variables
2976 
2977  enters("Petsc_MatCreateSeqAIJ",err,error,*999)
2978 
2979  CALL matcreateseqaij(communicator,m,n,numbernonzerosperrow,numbernonzeroseachrow,a%mat,err)
2980  IF(err/=0) THEN
2981  IF(petschandleerror) THEN
2982  chkerrq(err)
2983  ENDIF
2984  CALL flagerror("PETSc error in MatCreateSeqAIJ.",err,error,*999)
2985  ENDIF
2986 
2987  exits("Petsc_MatCreateSeqAIJ")
2988  RETURN
2989 999 errorsexits("Petsc_MatCreateSeqAIJ",err,error)
2990  RETURN 1
2991 
2992  END SUBROUTINE petsc_matcreateseqaij
2993 
2994  !
2995  !================================================================================================================================
2996  !
2997 
2999  SUBROUTINE petsc_matcreateseqdense(communicator,m,n,matrixData,a,err,error,*)
3001  !Argument Variables
3002  mpi_comm, INTENT(IN) :: communicator
3003  INTEGER(INTG), INTENT(IN) :: m
3004  INTEGER(INTG), INTENT(IN) :: n
3005  REAL(DP), INTENT(IN) :: matrixData(*)
3006  TYPE(petscmattype), INTENT(INOUT) :: a
3007  INTEGER(INTG), INTENT(OUT) :: err
3008  TYPE(varying_string), INTENT(OUT) :: error
3009  !Local Variables
3010 
3011  enters("Petsc_MatCreateSeqDense",err,error,*999)
3012 
3013  CALL matcreateseqdense(communicator,m,n,matrixdata,a%mat,err)
3014  IF(err/=0) THEN
3015  IF(petschandleerror) THEN
3016  chkerrq(err)
3017  ENDIF
3018  CALL flagerror("PETSc error in MatCreateSeqDense.",err,error,*999)
3019  ENDIF
3020 
3021  exits("Petsc_MatCreateSeqDense")
3022  RETURN
3023 999 errorsexits("Petsc_MatCreateSeqDense",err,error)
3024  RETURN 1
3025 
3026  END SUBROUTINE petsc_matcreateseqdense
3027 
3028  !
3029  !================================================================================================================================
3030  !
3031 
3033  SUBROUTINE petsc_matdensegetarrayf90(a,array,err,error,*)
3035  !Argument Variables
3036  TYPE(petscmattype), INTENT(INOUT), TARGET :: a
3037  REAL(DP), POINTER :: array(:,:)
3038  INTEGER(INTG), INTENT(OUT) :: err
3039  TYPE(varying_string), INTENT(OUT) :: error
3040  !Local Variables
3041 
3042  enters("Petsc_MatDenseGetArrayF90",err,error,*999)
3043 
3044  IF(ASSOCIATED(array)) THEN
3045  CALL flagerror("Array is already associated.",err,error,*999)
3046  ELSE
3047  CALL matdensegetarrayf90(a%mat,array,err)
3048  IF(err/=0) THEN
3049  IF(petschandleerror) THEN
3050  chkerrq(err)
3051  ENDIF
3052  CALL flagerror("PETSc error in MatDenseGetArrayF90.",err,error,*999)
3053  ENDIF
3054  ENDIF
3055 
3056  exits("Petsc_MatDenseGetArrayF90")
3057  RETURN
3058 999 errorsexits("Petsc_MatDenseGetArrayF90",err,error)
3059  RETURN 1
3060 
3061  END SUBROUTINE petsc_matdensegetarrayf90
3062 
3063  !
3064  !================================================================================================================================
3065  !
3066 
3068  SUBROUTINE petsc_matdenserestorearrayf90(a,array,err,error,*)
3070  !Argument Variables
3071  TYPE(petscmattype), INTENT(INOUT) :: a
3072  REAL(DP), POINTER :: array(:,:)
3073  INTEGER(INTG), INTENT(OUT) :: err
3074  TYPE(varying_string), INTENT(OUT) :: error
3075  !Local Variables
3076 
3077  enters("Petsc_MatDenseRestoreArrayF90",err,error,*999)
3078 
3079  CALL matdenserestorearrayf90(a%mat,array,err)
3080  IF(err/=0) THEN
3081  IF(petschandleerror) THEN
3082  chkerrq(err)
3083  ENDIF
3084  CALL flagerror("PETSc error in MatDenseRestoreArrayF90.",err,error,*999)
3085  ENDIF
3086 
3087  exits("Petsc_MatDenseRestoreArrayF90")
3088  RETURN
3089 999 errorsexits("Petsc_MatDenseRestoreArrayF90",err,error)
3090  RETURN 1
3091 
3092  END SUBROUTINE petsc_matdenserestorearrayf90
3093 
3094  !
3095  !================================================================================================================================
3096  !
3097 
3099  SUBROUTINE petsc_matdestroy(a,err,error,*)
3101  !Argument Variables
3102  TYPE(petscmattype), INTENT(INOUT) :: a
3103  INTEGER(INTG), INTENT(OUT) :: err
3104  TYPE(varying_string), INTENT(OUT) :: error
3105  !Local Variables
3106 
3107  enters("Petsc_MatDestroy",err,error,*999)
3108 
3109  CALL matdestroy(a%mat,err)
3110  IF(err/=0) THEN
3111  IF(petschandleerror) THEN
3112  chkerrq(err)
3113  ENDIF
3114  CALL flagerror("PETSc error in MatDestroy.",err,error,*999)
3115  ENDIF
3116  a%mat=petsc_null_object
3117 
3118  exits("Petsc_MatDestroy")
3119  RETURN
3120 999 errorsexits("Petsc_MatDestroy",err,error)
3121  RETURN 1
3122 
3123  END SUBROUTINE petsc_matdestroy
3124 
3125  !
3126  !================================================================================================================================
3127  !
3128 
3130  SUBROUTINE petsc_matgetinfo(a,flag,info,err,error,*)
3132  !Argument Variables
3133  TYPE(petscmattype), INTENT(INOUT) :: a
3134  matinfotype, INTENT(IN) :: flag
3135  matinfo, INTENT(OUT) :: info(mat_info_size)
3136  INTEGER(INTG), INTENT(OUT) :: err
3137  TYPE(varying_string), INTENT(OUT) :: error
3138  !Local Variables
3139 
3140  enters("Petsc_MatGetInfo",err,error,*999)
3141 
3142  CALL matgetinfo(a%mat,flag,info,err)
3143  IF(err/=0) THEN
3144  IF(petschandleerror) THEN
3145  chkerrq(err)
3146  ENDIF
3147  CALL flagerror("PETSc error in MatGetInfo.",err,error,*999)
3148  ENDIF
3149 
3150  exits("Petsc_MatGetInfo")
3151  RETURN
3152 999 errorsexits("Petsc_MatGetInfo",err,error)
3153  RETURN 1
3154 
3155  END SUBROUTINE petsc_matgetinfo
3156 
3157  !
3158  !================================================================================================================================
3159  !
3160 
3162  SUBROUTINE petsc_matgetownershiprange(a,firstRow,lastRow,err,error,*)
3164  !Argument Variables
3165  TYPE(petscmattype), INTENT(INOUT) :: a
3166  INTEGER(INTG), INTENT(OUT) :: firstRow
3167  INTEGER(INTG), INTENT(OUT) :: lastRow
3168  INTEGER(INTG), INTENT(OUT) :: err
3169  TYPE(varying_string), INTENT(OUT) :: error
3170  !Local Variables
3171 
3172  enters("Petsc_MatGetOwnershipRange",err,error,*999)
3173 
3174  CALL matgetownershiprange(a%mat,firstrow,lastrow,err)
3175  IF(err/=0) THEN
3176  IF(petschandleerror) THEN
3177  chkerrq(err)
3178  ENDIF
3179  CALL flagerror("PETSc error in MatGetOwnershipRange.",err,error,*999)
3180  ENDIF
3181 
3182  exits("Petsc_MatGetOwnershipRange")
3183  RETURN
3184 999 errorsexits("Petsc_MatGetOwnershipRange",err,error)
3185  RETURN 1
3186 
3187  END SUBROUTINE petsc_matgetownershiprange
3188 
3189  !
3190  !================================================================================================================================
3191  !
3192 
3194  SUBROUTINE petsc_matgetrow(A,rowNumber,numberOfColumns,columns,values,err,error,*)
3196  !Argument Variables
3197  TYPE(petscmattype), INTENT(INOUT) :: A
3198  INTEGER(INTG), INTENT(IN) :: rowNumber
3199  INTEGER(INTG), INTENT(OUT) :: numberOfColumns
3200  INTEGER(INTG), INTENT(OUT) :: columns(:)
3201  REAL(DP), INTENT(OUT) :: values(:)
3202  INTEGER(INTG), INTENT(OUT) :: err
3203  TYPE(varying_string), INTENT(OUT) :: error
3204  !Local Variables
3205 
3206  enters("Petsc_MatGetRow",err,error,*999)
3207 
3208  CALL matgetrow(a%mat,rownumber,numberofcolumns,columns,values,err)
3209  IF(err/=0) THEN
3210  IF(petschandleerror) THEN
3211  chkerrq(err)
3212  ENDIF
3213  CALL flagerror("PETSc error in MatGetRow.",err,error,*999)
3214  ENDIF
3215 
3216  exits("Petsc_MatGetRow")
3217  RETURN
3218 999 errorsexits("Petsc_MatGetRow",err,error)
3219  RETURN 1
3220 
3221  END SUBROUTINE petsc_matgetrow
3222 
3223  !
3224  !================================================================================================================================
3225  !
3226 
3228  SUBROUTINE petsc_matgetvalues(a,m,mIndices,n,nIndices,values,err,error,*)
3230  !Argument Variables
3231  TYPE(petscmattype), INTENT(INOUT) :: a
3232  INTEGER(INTG), INTENT(IN) :: m
3233  INTEGER(INTG), INTENT(IN) :: mIndices(*)
3234  INTEGER(INTG), INTENT(IN) :: n
3235  INTEGER(INTG), INTENT(IN) :: nIndices(*)
3236  REAL(DP), INTENT(OUT) :: values(*)
3237  INTEGER(INTG), INTENT(OUT) :: err
3238  TYPE(varying_string), INTENT(OUT) :: error
3239  !Local Variables
3240 
3241  enters("Petsc_MatGetValues",err,error,*999)
3242 
3243  CALL matgetvalues(a%mat,m,mindices,n,nindices,values,err)
3244  IF(err/=0) THEN
3245  IF(petschandleerror) THEN
3246  chkerrq(err)
3247  ENDIF
3248  CALL flagerror("PETSc error in MatGetValues.",err,error,*999)
3249  ENDIF
3250 
3251  exits("Petsc_MatGetValues")
3252  RETURN
3253 999 errorsexits("Petsc_MatGetValues",err,error)
3254  RETURN 1
3255 
3256  END SUBROUTINE petsc_matgetvalues
3257 
3258  !
3259  !================================================================================================================================
3260  !
3261 
3263  SUBROUTINE petsc_matmumpsseticntl(factoredMatrix,icntl,ival,err,error,*)
3265  !Argument Variables
3266  TYPE(petscmattype), INTENT(INOUT) :: factoredMatrix
3267  INTEGER(INTG), INTENT(IN) :: icntl
3268  INTEGER(INTG), INTENT(IN) :: ival
3269  INTEGER(INTG), INTENT(OUT) :: err
3270  TYPE(varying_string), INTENT(OUT) :: error
3271  !Local Variables
3272 
3273  enters("Petsc_MatMumpsSetIcntl",err,error,*999)
3274 
3275  CALL matmumpsseticntl(factoredmatrix%mat,icntl,ival,err)
3276  IF(err/=0) THEN
3277  IF(petschandleerror) THEN
3278  chkerrq(err)
3279  ENDIF
3280  CALL flagerror("PETSc error in MatMumpsSetIcntl.",err,error,*999)
3281  ENDIF
3282 
3283  exits("Petsc_MatMumpsSetIcntl")
3284  RETURN
3285 999 errorsexits("Petsc_MatMumpsSetIcntl",err,error)
3286  RETURN 1
3287 
3288  END SUBROUTINE petsc_matmumpsseticntl
3289 
3290  !
3291  !================================================================================================================================
3292  !
3293 
3295  SUBROUTINE petsc_matmumpssetcntl(factoredMatrix,icntl,val,err,error,*)
3297  !Argument Variables
3298  TYPE(petscmattype), INTENT(INOUT) :: factoredMatrix
3299  INTEGER(INTG), INTENT(IN) :: icntl
3300  REAL(DP), INTENT(IN) :: val
3301  INTEGER(INTG), INTENT(OUT) :: err
3302  TYPE(varying_string), INTENT(OUT) :: error
3303  !Local Variables
3304 
3305  enters("Petsc_MatMumpsSetCntl",err,error,*999)
3306 
3307  CALL matmumpssetcntl(factoredmatrix%mat,icntl,val,err)
3308  IF(err/=0) THEN
3309  IF(petschandleerror) THEN
3310  chkerrq(err)
3311  ENDIF
3312  CALL flagerror("PETSc error in MatMumpsSetCntl.",err,error,*999)
3313  ENDIF
3314 
3315  exits("Petsc_MatMumpsSetCntl")
3316  RETURN
3317 999 errorsexits("Petsc_MatMumpsSetCntl",err,error)
3318  RETURN 1
3319 
3320  END SUBROUTINE petsc_matmumpssetcntl
3321 
3322  !
3323  !================================================================================================================================
3324  !
3325 
3327  SUBROUTINE petsc_matrestorerow(A,rowNumber,numberOfColumns,columns,values,err,error,*)
3329  !Argument Variables
3330  TYPE(petscmattype), INTENT(INOUT) :: A
3331  INTEGER(INTG), INTENT(IN) :: rowNumber
3332  INTEGER(INTG), INTENT(OUT) :: numberOfColumns
3333  INTEGER(INTG), INTENT(OUT) :: columns(:)
3334  REAL(DP), INTENT(OUT) :: values(:)
3335  INTEGER(INTG), INTENT(OUT) :: err
3336  TYPE(varying_string), INTENT(OUT) :: error
3337  !Local Variables
3338 
3339  enters("Petsc_MatRestoreRow",err,error,*999)
3340 
3341  CALL matrestorerow(a%mat,rownumber,numberofcolumns,columns,values,err)
3342  IF(err/=0) THEN
3343  IF(petschandleerror) THEN
3344  chkerrq(err)
3345  ENDIF
3346  CALL flagerror("PETSc error in MatRestoreRow.",err,error,*999)
3347  ENDIF
3348 
3349  exits("Petsc_MatRestoreRow")
3350  RETURN
3351 999 errorsexits("Petsc_MatRestoreRow",err,error)
3352  RETURN 1
3353 
3354  END SUBROUTINE petsc_matrestorerow
3355 
3356  !
3357  !================================================================================================================================
3358  !
3359 
3361  SUBROUTINE petsc_matseqaijgetarrayf90(a,array,err,error,*)
3363  !Argument Variables
3364  TYPE(petscmattype), INTENT(INOUT), TARGET :: a
3365  REAL(DP), POINTER :: array(:,:)
3366  INTEGER(INTG), INTENT(OUT) :: err
3367  TYPE(varying_string), INTENT(OUT) :: error
3368  !Local Variables
3369 
3370  enters("Petsc_MatSeqAIJGetArrayF90",err,error,*999)
3371 
3372  IF(ASSOCIATED(array)) THEN
3373  CALL flagerror("Array is already associated.",err,error,*999)
3374  ELSE
3375  CALL matseqaijgetarrayf90(a%mat,array,err)
3376  IF(err/=0) THEN
3377  IF(petschandleerror) THEN
3378  chkerrq(err)
3379  ENDIF
3380  CALL flagerror("PETSc error in MatSeqAIJGetArrayF90.",err,error,*999)
3381  ENDIF
3382  ENDIF
3383 
3384  exits("Petsc_MatSeqAIJGetArrayF90")
3385  RETURN
3386 999 errorsexits("Petsc_MatSeqAIJGetArrayF90",err,error)
3387  RETURN 1
3388 
3389  END SUBROUTINE petsc_matseqaijgetarrayf90
3390 
3391  !
3392  !================================================================================================================================
3393  !
3394 
3396  SUBROUTINE petsc_matseqaijgetmaxrownonzeros(a,maxNumberNonZeros,err,error,*)
3398  !Argument Variables
3399  TYPE(petscmattype), INTENT(INOUT) :: a
3400  INTEGER(INTG), INTENT(OUT) :: maxNumberNonZeros
3401  INTEGER(INTG), INTENT(OUT) :: err
3402  TYPE(varying_string), INTENT(OUT) :: error
3403  !Local Variables
3404 
3405  enters("Petsc_MatSeqAIJGetMaxRowNonzeros",err,error,*999)
3406 
3407  !CALL MatSeqAIJGetMaxRowNonzeros(A%mat,maxNumberNonZeros,err)
3408  maxnumbernonzeros=0
3409  CALL flagerror("Not implemented.",err,error,*999)
3410  IF(err/=0) THEN
3411  IF(petschandleerror) THEN
3412  chkerrq(err)
3413  ENDIF
3414  CALL flagerror("PETSc error in MatSeqAIJGetMaxRowNonzeros.",err,error,*999)
3415  ENDIF
3416 
3417  exits("Petsc_MatSeqAIJGetMaxRowNonzeros")
3418  RETURN
3419 999 errorsexits("Petsc_MatSeqAIJGetMaxRowNonzeros",err,error)
3420  RETURN 1
3421 
3422  END SUBROUTINE petsc_matseqaijgetmaxrownonzeros
3423 
3424  !
3425  !================================================================================================================================
3426  !
3427 
3429  SUBROUTINE petsc_matseqaijrestorearrayf90(a,array,err,error,*)
3431  !Argument Variables
3432  TYPE(petscmattype), INTENT(INOUT) :: a
3433  REAL(DP), POINTER :: array(:,:)
3434  INTEGER(INTG), INTENT(OUT) :: err
3435  TYPE(varying_string), INTENT(OUT) :: error
3436  !Local Variables
3437 
3438  enters("MatSeqAIJRestoreArrayF90",err,error,*999)
3439 
3440  CALL matseqaijrestorearrayf90(a%mat,array,err)
3441  IF(err/=0) THEN
3442  IF(petschandleerror) THEN
3443  chkerrq(err)
3444  ENDIF
3445  CALL flagerror("PETSc error in MatSeqAIJRestoreArrayF90.",err,error,*999)
3446  ENDIF
3447 
3448  exits("MatSeqAIJRestoreArrayF90")
3449  RETURN
3450 999 errorsexits("MatSeqAIJRestoreArrayF90",err,error)
3451  RETURN 1
3452 
3453  END SUBROUTINE petsc_matseqaijrestorearrayf90
3454 
3455  !
3456  !================================================================================================================================
3457  !
3458 
3460  SUBROUTINE petsc_matsetlocaltoglobalmapping(a,isLocalToGlobalMapping,err,error,*)
3462  !Argument Variables
3463  TYPE(petscmattype), INTENT(INOUT) :: a
3464  TYPE(petscislocaltogloabalmappingtype), INTENT(IN) :: isLocalToGlobalMapping
3465  INTEGER(INTG), INTENT(OUT) :: err
3466  TYPE(varying_string), INTENT(OUT) :: error
3467  !Local Variables
3468 
3469  enters("Petsc_MatSetLocalToGlobalMapping",err,error,*999)
3470 
3471  CALL matsetlocaltoglobalmapping(a%mat,islocaltoglobalmapping%isLocalToGlobalMapping,err)
3472  IF(err/=0) THEN
3473  IF(petschandleerror) THEN
3474  chkerrq(err)
3475  ENDIF
3476  CALL flagerror("PETSc error in MatSetLocalToGlobalMapping.",err,error,*999)
3477  ENDIF
3478 
3479  exits("Petsc_MatSetLocalToGlobalMapping")
3480  RETURN
3481 999 errorsexits("Petsc_MatSetLocalToGlobalMapping",err,error)
3482  RETURN 1
3483 
3484  END SUBROUTINE petsc_matsetlocaltoglobalmapping
3485 
3486  !
3487  !================================================================================================================================
3488  !
3489 
3491  SUBROUTINE petsc_matsetoption(a,option,flag,err,error,*)
3493  !Argument Variables
3494  TYPE(petscmattype), INTENT(INOUT) :: a
3495  matoption, INTENT(IN) :: option
3496  LOGICAL, INTENT(IN) :: flag
3497  INTEGER(INTG), INTENT(OUT) :: err
3498  TYPE(varying_string), INTENT(OUT) :: error
3499  !Local Variables
3500 
3501  enters("Petsc_MatSetOption",err,error,*999)
3502 
3503  IF(flag) THEN
3504  CALL matsetoption(a%mat,option,petsc_true,err)
3505  ELSE
3506  CALL matsetoption(a%mat,option,petsc_false,err)
3507  ENDIF
3508  IF(err/=0) THEN
3509  IF(petschandleerror) THEN
3510  chkerrq(err)
3511  ENDIF
3512  CALL flagerror("PETSc error in MatSetOption.",err,error,*999)
3513  ENDIF
3514 
3515  exits("Petsc_MatSetOption")
3516  RETURN
3517 999 errorsexits("Petsc_MatSetOption",err,error)
3518  RETURN 1
3519 
3520  END SUBROUTINE petsc_matsetoption
3521 
3522  !
3523  !================================================================================================================================
3524  !
3525 
3527  SUBROUTINE petsc_matsetsizes(a,localM,localN,globalM,globalN,err,error,*)
3529  !Argument Variables
3530  TYPE(petscmattype), INTENT(INOUT) :: a
3531  INTEGER(INTG), INTENT(IN) :: localM
3532  INTEGER(INTG), INTENT(IN) :: localN
3533  INTEGER(INTG), INTENT(IN) :: globalM
3534  INTEGER(INTG), INTENT(IN) :: globalN
3535  INTEGER(INTG), INTENT(OUT) :: err
3536  TYPE(varying_string), INTENT(OUT) :: error
3537  !Local Variables
3538 
3539  enters("Petsc_MatSetSizes",err,error,*999)
3540 
3541  CALL matsetsizes(a%mat,localm,localn,globalm,globaln,err)
3542  IF(err/=0) THEN
3543  IF(petschandleerror) THEN
3544  chkerrq(err)
3545  ENDIF
3546  CALL flagerror("PETSc error in MatSetSizes.",err,error,*999)
3547  ENDIF
3548 
3549  exits("Petsc_MatSetSizes")
3550  RETURN
3551 999 errorsexits("Petsc_MatSetSizes",err,error)
3552  RETURN 1
3553 
3554  END SUBROUTINE petsc_matsetsizes
3555 
3556  !
3557  !================================================================================================================================
3558  !
3559 
3561  SUBROUTINE petsc_matsettype(a,matrixType,err,error,*)
3563  !Argument Variables
3564  TYPE(petscmattype), INTENT(INOUT) :: a
3565  mattype, INTENT(IN) :: matrixtype
3566  INTEGER(INTG), INTENT(OUT) :: err
3567  TYPE(varying_string), INTENT(OUT) :: error
3568  !Local Variables
3569 
3570  enters("Petsc_MatSetType",err,error,*999)
3571 
3572  CALL matsettype(a%mat,matrixtype,err)
3573  IF(err/=0) THEN
3574  IF(petschandleerror) THEN
3575  chkerrq(err)
3576  ENDIF
3577  CALL flagerror("PETSc error in MatSetType.",err,error,*999)
3578  ENDIF
3579 
3580  exits("Petsc_MatSetType")
3581  RETURN
3582 999 errorsexits("Petsc_MatSetType",err,error)
3583  RETURN 1
3584 
3585  END SUBROUTINE petsc_matsettype
3586 
3587  !
3588  !================================================================================================================================
3589  !
3590 
3592  SUBROUTINE petsc_matsetvalue(a,row,col,value,insertMode,err,error,*)
3594  !Argument Variables
3595  TYPE(petscmattype), INTENT(INOUT) :: a
3596  INTEGER(INTG), INTENT(IN) :: row
3597  INTEGER(INTG), INTENT(IN) :: col
3598  REAL(DP), INTENT(IN) :: value
3599  insertmode, INTENT(IN) :: insertmode
3600  INTEGER(INTG), INTENT(OUT) :: err
3601  TYPE(varying_string), INTENT(OUT) :: error
3602  !Local Variables
3603 
3604  enters("Petsc_MatSetValue",err,error,*999)
3605 
3606  CALL matsetvalue(a%mat,row,col,value,insertmode,err)
3607  IF(err/=0) THEN
3608  IF(petschandleerror) THEN
3609  chkerrq(err)
3610  ENDIF
3611  CALL flagerror("PETSc error in MatSetValue.",err,error,*999)
3612  ENDIF
3613 
3614  exits("Petsc_MatSetValue")
3615  RETURN
3616 999 errorsexits("Petsc_MatSetValue",err,error)
3617  RETURN 1
3618 
3619  END SUBROUTINE petsc_matsetvalue
3620 
3621  !
3622  !================================================================================================================================
3623  !
3624 
3626  SUBROUTINE petsc_matsetvalues(a,m,mIndices,n,nIndices,values,insertMode,err,error,*)
3628  !Argument Variables
3629  TYPE(petscmattype), INTENT(INOUT) :: a
3630  INTEGER(INTG), INTENT(IN) :: m
3631  INTEGER(INTG), INTENT(IN) :: mIndices(*)
3632  INTEGER(INTG), INTENT(IN) :: n
3633  INTEGER(INTG), INTENT(IN) :: nIndices(*)
3634  REAL(DP), INTENT(IN) :: values(*)
3635  insertmode, INTENT(IN) :: insertmode
3636  INTEGER(INTG), INTENT(OUT) :: err
3637  TYPE(varying_string), INTENT(OUT) :: error
3638  !Local Variables
3639 
3640  enters("Petsc_MatSetValues",err,error,*999)
3641 
3642  CALL matsetvalues(a%mat,m,mindices,n,nindices,values,insertmode,err)
3643  IF(err/=0) THEN
3644  IF(petschandleerror) THEN
3645  chkerrq(err)
3646  ENDIF
3647  CALL flagerror("PETSc error in MatSetValues.",err,error,*999)
3648  ENDIF
3649 
3650  exits("Petsc_MatSetValues")
3651  RETURN
3652 999 errorsexits("Petsc_MatSetValues",err,error)
3653  RETURN 1
3654 
3655  END SUBROUTINE petsc_matsetvalues
3656 
3657  !
3658  !================================================================================================================================
3659  !
3661  SUBROUTINE petsc_matsetvaluelocal(a,row,col,VALUE,insertMode,err,error,*)
3662  !Argument Variables
3663  TYPE(petscmattype), INTENT(INOUT) :: a
3664  INTEGER(INTG), INTENT(IN) :: row
3665  INTEGER(INTG), INTENT(IN) :: col
3666  REAL(DP), INTENT(IN) :: value
3667  insertmode, INTENT(IN) :: insertmode
3668  INTEGER(INTG), INTENT(OUT) :: err
3669  TYPE(varying_string), INTENT(OUT) :: error
3670  !Local Variables
3671 
3672  enters("Petsc_MatSetValueLocal",err,error,*999)
3673 
3674  CALL matsetvaluelocal(a%mat,row,col,value,insertmode,err)
3675  IF(err/=0) THEN
3676  IF(petschandleerror) THEN
3677  chkerrq(err)
3678  ENDIF
3679  CALL flagerror("PETSc error in MatSetValueLocal.",err,error,*999)
3680  ENDIF
3681 
3682  exits("Petsc_MatSetValueLocal")
3683  RETURN
3684 999 errorsexits("Petsc_MatSetValueLocal",err,error)
3685  RETURN 1
3686  END SUBROUTINE petsc_matsetvaluelocal
3687 
3688  !
3689  !================================================================================================================================
3690  !
3691 
3693  SUBROUTINE petsc_matsetvalueslocal(a,m,mIndices,n,nIndices,values,insertMode,err,error,*)
3695  !Argument Variables
3696  TYPE(petscmattype), INTENT(INOUT) :: a
3697  INTEGER(INTG), INTENT(IN) :: m
3698  INTEGER(INTG), INTENT(IN) :: mIndices(:)
3699  INTEGER(INTG), INTENT(IN) :: n
3700  INTEGER(INTG), INTENT(IN) :: nIndices(:)
3701  REAL(DP), INTENT(IN) :: values(:)
3702  insertmode, INTENT(IN) :: insertmode
3703  INTEGER(INTG), INTENT(OUT) :: err
3704  TYPE(varying_string), INTENT(OUT) :: error
3705  !Local Variables
3706 
3707  enters("Petsc_MatSetValuesLocal",err,error,*999)
3708 
3709  CALL matsetvalueslocal(a%mat,m,mindices,n,nindices,values,insertmode,err)
3710  IF(err/=0) THEN
3711  IF(petschandleerror) THEN
3712  chkerrq(err)
3713  ENDIF
3714  CALL flagerror("PETSc error in MatSetValuesLocal.",err,error,*999)
3715  ENDIF
3716 
3717  exits("Petsc_MatSetValuesLocal")
3718  RETURN
3719 999 errorsexits("Petsc_MatSetValuesLocal",err,error)
3720  RETURN 1
3721 
3722  END SUBROUTINE petsc_matsetvalueslocal
3723 
3724  !
3725  !================================================================================================================================
3726  !
3727 
3729  SUBROUTINE petsc_matview(a,viewer,err,error,*)
3731  !Argument Variables
3732  TYPE(petscmattype), INTENT(INOUT) :: a
3733  petscviewer, INTENT(IN) :: viewer
3734  INTEGER(INTG), INTENT(OUT) :: err
3735  TYPE(varying_string), INTENT(OUT) :: error
3736  !Local Variables
3737 
3738  enters("Petsc_MatView",err,error,*999)
3739 
3740  CALL matview(a%mat,viewer,err)
3741  IF(err/=0) THEN
3742  IF(petschandleerror) THEN
3743  chkerrq(err)
3744  ENDIF
3745  CALL flagerror("PETSc error in MatView.",err,error,*999)
3746  ENDIF
3747 
3748  exits("Petsc_MatView")
3749  RETURN
3750 999 errorsexits("Petsc_MatView",err,error)
3751  RETURN 1
3752 
3753  END SUBROUTINE petsc_matview
3754 
3755  !
3756  !================================================================================================================================
3757  !
3758 
3760  SUBROUTINE petsc_matzeroentries(a,err,error,*)
3762  !Argument Variables
3763  TYPE(petscmattype), INTENT(INOUT) :: a
3764  INTEGER(INTG), INTENT(OUT) :: err
3765  TYPE(varying_string), INTENT(OUT) :: error
3766  !Local Variables
3767 
3768  enters("Petsc_MatZeroEntries",err,error,*999)
3769 
3770  CALL matzeroentries(a%mat,err)
3771  IF(err/=0) THEN
3772  IF(petschandleerror) THEN
3773  chkerrq(err)
3774  ENDIF
3775  CALL flagerror("PETSc error in MatZeroEntries.",err,error,*999)
3776  ENDIF
3777 
3778  exits("Petsc_MatZeroEntries")
3779  RETURN
3780 999 errorsexits("Petsc_MatZeroEntries",err,error)
3781  RETURN 1
3782 
3783  END SUBROUTINE petsc_matzeroentries
3784 
3785  !
3786  !================================================================================================================================
3787  !
3788 
3789  !Finalise the PETSc MatColoring structure and destroy the MatColoring
3790  SUBROUTINE petsc_matcoloringfinalise(matColoring,err,error,*)
3792  !Argument Variables
3793  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3794  INTEGER(INTG), INTENT(OUT) :: err
3795  TYPE(varying_string), INTENT(OUT) :: error
3796  !Local Variables
3797 
3798  enters("Petsc_MatColoringFinalise",err,error,*999)
3799 
3800  IF(matcoloring%matColoring/=petsc_null_object) THEN
3801  CALL petsc_matcoloringdestroy(matcoloring,err,error,*999)
3802  ENDIF
3803 
3804  exits("Petsc_MatColoringFinalise")
3805  RETURN
3806 999 errorsexits("Petsc_MatColoringFinalise",err,error)
3807  RETURN 1
3808 
3809  END SUBROUTINE petsc_matcoloringfinalise
3810 
3811  !
3812  !================================================================================================================================
3813  !
3814 
3815  !Initialise the PETSc MatColoring structure
3816  SUBROUTINE petsc_matcoloringinitialise(matColoring,err,error,*)
3818  !Argument Variables
3819  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3820  INTEGER(INTG), INTENT(OUT) :: err
3821  TYPE(varying_string), INTENT(OUT) :: error
3822  !Local Variables
3823 
3824  enters("Petsc_MatColoringInitialise",err,error,*999)
3825 
3826  matcoloring%matColoring=petsc_null_object
3827 
3828  exits("Petsc_MatColoringInitialise")
3829  RETURN
3830 999 errorsexits("Petsc_MatColoringInitialise",err,error)
3831  RETURN 1
3832 
3833  END SUBROUTINE petsc_matcoloringinitialise
3834 
3835  !
3836  !================================================================================================================================
3837  !
3838 
3840  SUBROUTINE petsc_matcoloringapply(matColoring,isColoring,err,error,*)
3842  !Argument Variables
3843  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3844  TYPE(petsciscoloringtype), INTENT(INOUT) :: isColoring
3845  INTEGER(INTG), INTENT(OUT) :: err
3846  TYPE(varying_string), INTENT(OUT) :: error
3847  !Local Variables
3848 
3849  enters("Petsc_MatColoringApply",err,error,*999)
3850 
3851  CALL matcoloringapply(matcoloring%matColoring,iscoloring%isColoring,err)
3852  IF(err/=0) THEN
3853  IF(petschandleerror) THEN
3854  chkerrq(err)
3855  ENDIF
3856  CALL flagerror("PETSc error in MatColoringApply.",err,error,*999)
3857  ENDIF
3858 
3859  exits("Petsc_MatColoringApply")
3860  RETURN
3861 999 errorsexits("Petsc_MatColoringApply",err,error)
3862  RETURN 1
3863 
3864  END SUBROUTINE petsc_matcoloringapply
3865 
3866  !
3867  !================================================================================================================================
3868  !
3869 
3871  SUBROUTINE petsc_matcoloringcreate(a,matColoring,err,error,*)
3873  !Argument Variables
3874  TYPE(petscmattype), INTENT(INOUT) :: a
3875  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3876  INTEGER(INTG), INTENT(OUT) :: err
3877  TYPE(varying_string), INTENT(OUT) :: error
3878  !Local Variables
3879 
3880  enters("Petsc_MatColoringCreate",err,error,*999)
3881 
3882  CALL matcoloringcreate(a%mat,matcoloring%matColoring,err)
3883  IF(err/=0) THEN
3884  IF(petschandleerror) THEN
3885  chkerrq(err)
3886  ENDIF
3887  CALL flagerror("PETSc error in MatColoringCreate.",err,error,*999)
3888  ENDIF
3889 
3890  exits("Petsc_MatColoringCreate")
3891  RETURN
3892 999 errorsexits("Petsc_MatColoringCreate",err,error)
3893  RETURN 1
3894 
3895  END SUBROUTINE petsc_matcoloringcreate
3896 
3897  !
3898  !================================================================================================================================
3899  !
3900 
3902  SUBROUTINE petsc_matcoloringdestroy(matColoring,err,error,*)
3904  !Argument Variables
3905  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3906  INTEGER(INTG), INTENT(OUT) :: err
3907  TYPE(varying_string), INTENT(OUT) :: error
3908  !Local Variables
3909 
3910  enters("Petsc_MatColoringDestroy",err,error,*999)
3911 
3912  CALL matcoloringdestroy(matcoloring%matColoring,err)
3913  IF(err/=0) THEN
3914  IF(petschandleerror) THEN
3915  chkerrq(err)
3916  ENDIF
3917  CALL flagerror("PETSc error in MatColoringDestroy.",err,error,*999)
3918  ENDIF
3919  matcoloring%matColoring=petsc_null_object
3920 
3921  exits("Petsc_MatColoringDestroy")
3922  RETURN
3923 999 errorsexits("Petsc_MatColoringDestroy",err,error)
3924  exits("Petsc_MatColoringDestroy")
3925  RETURN 1
3926 
3927  END SUBROUTINE petsc_matcoloringdestroy
3928 
3929  !
3930  !================================================================================================================================
3931  !
3932 
3934  SUBROUTINE petsc_matcoloringsetfromoptions(matColoring,err,error,*)
3936  !Argument Variables
3937  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3938  INTEGER(INTG), INTENT(OUT) :: err
3939  TYPE(varying_string), INTENT(OUT) :: error
3940  !Local Variables
3941 
3942  enters("Petsc_MatColoringSetFromOptions",err,error,*999)
3943 
3944  CALL matcoloringsetfromoptions(matcoloring%matColoring,err)
3945  IF(err/=0) THEN
3946  IF(petschandleerror) THEN
3947  chkerrq(err)
3948  ENDIF
3949  CALL flagerror("PETSc error in MatColoringSetFromOptions.",err,error,*999)
3950  ENDIF
3951 
3952  exits("Petsc_MatColoringSetFromOptions")
3953  RETURN
3954 999 errorsexits("Petsc_MatColoringSetFromOptions",err,error)
3955  RETURN 1
3956 
3957  END SUBROUTINE petsc_matcoloringsetfromoptions
3958 
3959  !
3960  !================================================================================================================================
3961  !
3962 
3964  SUBROUTINE petsc_matcoloringsettype(matColoring,coloringType,err,error,*)
3966  !Argument Variables
3967  TYPE(petscmatcoloringtype), INTENT(INOUT) :: matColoring
3968  matcoloringtype, INTENT(IN) :: coloringtype
3969  INTEGER(INTG), INTENT(OUT) :: err
3970  TYPE(varying_string), INTENT(OUT) :: error
3971  !Local Variables
3972 
3973  enters("Petsc_MatColoringSetType",err,error,*999)
3974 
3975  CALL matcoloringsettype(matcoloring%matColoring,coloringtype,err)
3976  IF(err/=0) THEN
3977  IF(petschandleerror) THEN
3978  chkerrq(err)
3979  ENDIF
3980  CALL flagerror("PETSc error in MatColoringSetType.",err,error,*999)
3981  ENDIF
3982 
3983  exits("Petsc_MatColoringSetType")
3984  RETURN
3985 999 errorsexits("Petsc_MatColoringSetType",err,error)
3986  RETURN 1
3987 
3988  END SUBROUTINE petsc_matcoloringsettype
3989 
3990  !
3991  !================================================================================================================================
3992  !
3993 
3994  !Finalise the PETSc MatFDColoring structure and destroy the MatFDColoring
3995  SUBROUTINE petsc_matfdcoloringfinalise(matFDColoring,err,error,*)
3997  !Argument Variables
3998  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
3999  INTEGER(INTG), INTENT(OUT) :: err
4000  TYPE(varying_string), INTENT(OUT) :: error
4001  !Local Variables
4002 
4003  enters("Petsc_MatFDColoringFinalise",err,error,*999)
4004 
4005  IF(matfdcoloring%matFDColoring/=petsc_null_object) THEN
4006  CALL petsc_matfdcoloringdestroy(matfdcoloring,err,error,*999)
4007  ENDIF
4008 
4009  exits("Petsc_MatFDColoringFinalise")
4010  RETURN
4011 999 errorsexits("Petsc_MatFDColoringFinalise",err,error)
4012  RETURN 1
4013 
4014  END SUBROUTINE petsc_matfdcoloringfinalise
4015 
4016  !
4017  !================================================================================================================================
4018  !
4019 
4020  !Initialise the PETSc MatFDColoring structure
4021  SUBROUTINE petsc_matfdcoloringinitialise(matFDColoring,err,error,*)
4023  !Argument Variables
4024  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4025  INTEGER(INTG), INTENT(OUT) :: err
4026  TYPE(varying_string), INTENT(OUT) :: error
4027  !Local Variables
4028 
4029  enters("Petsc_MatFDColoringInitialise",err,error,*999)
4030 
4031  matfdcoloring%matFDColoring=petsc_null_object
4032 
4033  exits("Petsc_MatFDColoringInitialise")
4034  RETURN
4035 999 errorsexits("Petsc_MatFDColoringInitialise",err,error)
4036  RETURN 1
4037 
4038  END SUBROUTINE petsc_matfdcoloringinitialise
4039 
4040  !
4041  !================================================================================================================================
4042  !
4043 
4045  SUBROUTINE petsc_matfdcoloringcreate(a,isColoring,matFDColoring,err,error,*)
4047  !Argument Variables
4048  TYPE(petscmattype), INTENT(INOUT) :: a
4049  TYPE(petsciscoloringtype), INTENT(IN) :: isColoring
4050  TYPE(petscmatfdcoloringtype), INTENT(OUT) :: matFDColoring
4051  INTEGER(INTG), INTENT(OUT) :: err
4052  TYPE(varying_string), INTENT(OUT) :: error
4053  !Local Variables
4054 
4055  enters("Petsc_MatFDColoringCreate",err,error,*999)
4056 
4057  CALL matfdcoloringcreate(a%mat,iscoloring%isColoring,matfdcoloring%matFDColoring,err)
4058  IF(err/=0) THEN
4059  IF(petschandleerror) THEN
4060  chkerrq(err)
4061  ENDIF
4062  CALL flagerror("PETSc error in MatFDColoringCreate.",err,error,*999)
4063  ENDIF
4064 
4065  exits("Petsc_MatFDColoringCreate")
4066  RETURN
4067 999 errorsexits("Petsc_MatFDColoringCreate",err,error)
4068  RETURN 1
4069 
4070  END SUBROUTINE petsc_matfdcoloringcreate
4071 
4072  !
4073  !================================================================================================================================
4074  !
4075 
4077  SUBROUTINE petsc_matfdcoloringdestroy(matFDColoring,err,error,*)
4079  !Argument Variables
4080  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4081  INTEGER(INTG), INTENT(OUT) :: err
4082  TYPE(varying_string), INTENT(OUT) :: error
4083  !Local Variables
4084 
4085  enters("Petsc_MatFDColoringDestroy",err,error,*999)
4086 
4087  CALL matfdcoloringdestroy(matfdcoloring%matFDColoring,err)
4088  IF(err/=0) THEN
4089  IF(petschandleerror) THEN
4090  chkerrq(err)
4091  ENDIF
4092  CALL flagerror("PETSc error in MatFDColoringDestroy.",err,error,*999)
4093  ENDIF
4094  matfdcoloring%matFDColoring=petsc_null_object
4095 
4096  exits("Petsc_MatFDColoringDestroy")
4097  RETURN
4098 999 errorsexits("Petsc_MatFDColoringDestroy",err,error)
4099  RETURN 1
4100 
4101  END SUBROUTINE petsc_matfdcoloringdestroy
4102 
4103  !
4104  !================================================================================================================================2
4105  !
4106 
4108  SUBROUTINE petsc_matfdcoloringsetfromoptions(matFDColoring,err,error,*)
4110  !Argument Variables
4111  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4112  INTEGER(INTG), INTENT(OUT) :: err
4113  TYPE(varying_string), INTENT(OUT) :: error
4114  !Local Variables
4115 
4116  enters("Petsc_MatFDColoringSetFromOptions",err,error,*999)
4117 
4118  CALL matfdcoloringsetfromoptions(matfdcoloring%matFDColoring,err)
4119  IF(err/=0) THEN
4120  IF(petschandleerror) THEN
4121  chkerrq(err)
4122  ENDIF
4123  CALL flagerror("PETSc error in MatFDColoringSetFromOptions.",err,error,*999)
4124  ENDIF
4125 
4126  exits("Petsc_MatFDColoringSetFromOptions")
4127  RETURN
4128 999 errorsexits("Petsc_MatFDColoringSetFromOptions",err,error)
4129  RETURN 1
4130 
4131  END SUBROUTINE petsc_matfdcoloringsetfromoptions
4132 
4133  !
4134  !================================================================================================================================
4135  !
4136 
4138  SUBROUTINE petsc_matfdcoloringsetparameters(matFDColoring,rError,uMin,err,error,*)
4140  !Argument Variables
4141  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4142  REAL(DP) :: rError
4143  REAL(DP) :: uMin
4144  INTEGER(INTG), INTENT(OUT) :: err
4145  TYPE(varying_string), INTENT(OUT) :: error
4146  !Local Variables
4147 
4148  enters("Petsc_MatFDColoringSetParameters",err,error,*999)
4149 
4150  CALL matfdcoloringsetparameters(matfdcoloring%matFDColoring,rerror,umin,err)
4151  IF(err/=0) THEN
4152  IF(petschandleerror) THEN
4153  chkerrq(err)
4154  ENDIF
4155  CALL flagerror("PETSc error in MatFDColoringSetParameters.",err,error,*999)
4156  ENDIF
4157 
4158  exits("Petsc_MatFDColoringSetParameters")
4159  RETURN
4160 999 errorsexits("Petsc_MatFDColoringSetParameters",err,error)
4161  RETURN 1
4162 
4163  END SUBROUTINE petsc_matfdcoloringsetparameters
4164 
4165  !
4166  !================================================================================================================================
4167  !
4168 
4170  SUBROUTINE petsc_matfdcoloringsetfunction(matFDColoring,fFunction,ctx,err,error,*)
4172  !Argument Variables
4173  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4174  EXTERNAL ffunction
4175  TYPE(solver_type), POINTER :: ctx
4176  INTEGER(INTG), INTENT(OUT) :: err
4177  TYPE(varying_string), INTENT(OUT) :: error
4178  !Local Variables
4179 
4180  enters("Petsc_MatFDColoringSetFunction",err,error,*999)
4181 
4182  CALL matfdcoloringsetfunction(matfdcoloring%matFDColoring,ffunction,ctx,err)
4183  IF(err/=0) THEN
4184  IF(petschandleerror) THEN
4185  chkerrq(err)
4186  ENDIF
4187  CALL flagerror("PETSc error in MatFDColoringSetFunction.",err,error,*999)
4188  ENDIF
4189 
4190  exits("Petsc_MatFDColoringSetFunction")
4191  RETURN
4192 999 errorsexits("Petsc_MatFDColoringSetFunction",err,error)
4193  RETURN 1
4194 
4195  END SUBROUTINE petsc_matfdcoloringsetfunction
4196 
4197  !
4198  !================================================================================================================================
4199  !
4200 
4202  SUBROUTINE petsc_matfdcoloringsetup(a,isColoring,matFDColoring,err,error,*)
4204  !Argument Variables
4205  TYPE(petscmattype), INTENT(INOUT) :: a
4206  TYPE(petsciscoloringtype), INTENT(INOUT) :: isColoring
4207  TYPE(petscmatfdcoloringtype), INTENT(INOUT) :: matFDColoring
4208  INTEGER(INTG), INTENT(OUT) :: err
4209  TYPE(varying_string), INTENT(OUT) :: error
4210  !Local Variables
4211 
4212  enters("Petsc_MatFDColoringSetup",err,error,*999)
4213 
4214  CALL matfdcoloringsetup(a%mat,iscoloring%isColoring,matfdcoloring%matFDColoring,err)
4215  IF(err/=0) THEN
4216  IF(petschandleerror) THEN
4217  chkerrq(err)
4218  ENDIF
4219  CALL flagerror("PETSc error in MatFDColoringSetup.",err,error,*999)
4220  ENDIF
4221 
4222  exits("Petsc_MatFDColoringSetup")
4223  RETURN
4224 999 errorsexits("Petsc_MatFDColoringSetup",err,error)
4225  RETURN 1
4226 
4227  END SUBROUTINE petsc_matfdcoloringsetup
4228 
4229  !
4230  !================================================================================================================================
4231  !
4232 
4233  !Finalise the PETSc PC structure
4234  SUBROUTINE petsc_pcfinalise(pc,err,error,*)
4236  !Argument Variables
4237  TYPE(petscpctype), INTENT(INOUT) :: pc
4238  INTEGER(INTG), INTENT(OUT) :: err
4239  TYPE(varying_string), INTENT(OUT) :: error
4240  !Local Variables
4241 
4242  enters("Petsc_PCFinalise",err,error,*999)
4243 
4244  IF(pc%pc/=petsc_null_object) THEN
4245  !Do nothing - should be destroyed when the KSP is destroyed.
4246  ENDIF
4247 
4248  exits("Petsc_PCFinalise")
4249  RETURN
4250 999 errorsexits("Petsc_PCFinalise",err,error)
4251  RETURN 1
4252 
4253  END SUBROUTINE petsc_pcfinalise
4254 
4255  !
4256  !================================================================================================================================
4257  !
4258 
4259  !Initialise the PETSc PC structure
4260  SUBROUTINE petsc_pcinitialise(pc,err,error,*)
4262  !Argument Variables
4263  TYPE(petscpctype), INTENT(INOUT) :: pc
4264  INTEGER(INTG), INTENT(OUT) :: err
4265  TYPE(varying_string), INTENT(OUT) :: error
4266  !Local Variables
4267 
4268  enters("Petsc_PCInitialise",err,error,*999)
4269 
4270  pc%pc=petsc_null_object
4271 
4272  exits("Petsc_PCInitialise")
4273  RETURN
4274 999 errorsexits("Petsc_PCInitialise",err,error)
4275  RETURN 1
4276 
4277  END SUBROUTINE petsc_pcinitialise
4278 
4279  !
4280  !================================================================================================================================
4281  !
4282 
4284  SUBROUTINE petsc_pcfactorgetmatrix(pc,factoredMatrix,err,error,*)
4286  !Argument Variables
4287  TYPE(petscpctype), INTENT(INOUT) :: pc
4288  TYPE(petscmattype), INTENT(OUT) :: factoredMatrix
4289  INTEGER(INTG), INTENT(OUT) :: err
4290  TYPE(varying_string), INTENT(OUT) :: error
4291  !Local Variables
4292 
4293  enters("Petsc_PCFactorGetMatrix",err,error,*999)
4294 
4295  CALL pcfactorgetmatrix(pc%pc,factoredmatrix%mat,err)
4296  IF(err/=0) THEN
4297  IF(petschandleerror) THEN
4298  chkerrq(err)
4299  ENDIF
4300  CALL flagerror("PETSc error in PCFactorGetMatrix",err,error,*999)
4301  ENDIF
4302 
4303  exits("Petsc_PCFactorGetMatrix")
4304  RETURN
4305 999 errorsexits("Petsc_PCFactorGetMatrix",err,error)
4306  RETURN 1
4307 
4308  END SUBROUTINE petsc_pcfactorgetmatrix
4309 
4310  !
4311  !================================================================================================================================
4312  !
4313 
4315  SUBROUTINE petsc_pcfactorsetmatsolverpackage(pc,solverPackage,err,error,*)
4317  !Argument Variables
4318  TYPE(petscpctype), INTENT(INOUT) :: pc
4319  matsolverpackage, INTENT(IN) :: solverpackage
4320  INTEGER(INTG), INTENT(OUT) :: err
4321  TYPE(varying_string), INTENT(OUT) :: error
4322  !Local Variables
4323 
4324  enters("Petsc_PCFactorSetMatSolverPackage",err,error,*999)
4325 
4326  CALL pcfactorsetmatsolverpackage(pc%pc,solverpackage,err)
4327  IF(err/=0) THEN
4328  IF(petschandleerror) THEN
4329  chkerrq(err)
4330  ENDIF
4331  CALL flagerror("PETSc error in PCFactorSetMatSolverPackage.",err,error,*999)
4332  ENDIF
4333 
4334  exits("Petsc_PCFactorSetMatSolverPackage")
4335  RETURN
4336 999 errorsexits("Petsc_PCFactorSetMatSolverPackage",err,error)
4337  RETURN 1
4338 
4339  END SUBROUTINE petsc_pcfactorsetmatsolverpackage
4340 
4341  !
4342  !================================================================================================================================
4343  !
4344 
4346  SUBROUTINE petsc_pcfactorsetupmatsolverpackage(pc,err,error,*)
4348  !Argument Variables
4349  TYPE(petscpctype), INTENT(INOUT) :: pc
4350  INTEGER(INTG), INTENT(OUT) :: err
4351  TYPE(varying_string), INTENT(OUT) :: error
4352  !Local Variables
4353 
4354  enters("Petsc_PCFactorSetUpMatSolverPackage",err,error,*999)
4355 
4356  CALL pcfactorsetupmatsolverpackage(pc%pc,err)
4357  IF(err/=0) THEN
4358  IF(petschandleerror) THEN
4359  chkerrq(err)
4360  ENDIF
4361  CALL flagerror("PETSc error in PCFactorSetUpMatSolverPackage.",err,error,*999)
4362  ENDIF
4363 
4364  exits("Petsc_PCFactorSetUpMatSolverPackage")
4365  RETURN
4366 999 errorsexits("Petsc_PCFactorSetUpMatSolverPackage",err,error)
4367  RETURN 1
4368 
4370 
4371  !
4372  !================================================================================================================================
4373  !
4374 
4376  SUBROUTINE petsc_pcsetreusepreconditioner(pc,flag,err,error,*)
4378  !Argument Variables
4379  TYPE(petscpctype), INTENT(INOUT) :: pc
4380  LOGICAL, INTENT(IN) :: flag
4381  INTEGER(INTG), INTENT(OUT) :: err
4382  TYPE(varying_string), INTENT(OUT) :: error
4383  !Local Variables
4384 
4385  enters("Petsc_PCSetReusePreconditioner",err,error,*999)
4386 
4387  IF(flag) THEN
4388  CALL pcsetreusepreconditioner(pc%pc,petsc_true,err)
4389  ELSE
4390  CALL pcsetreusepreconditioner(pc%pc,petsc_false,err)
4391  ENDIF
4392  IF(err/=0) THEN
4393  IF(petschandleerror) THEN
4394  chkerrq(err)
4395  ENDIF
4396  CALL flagerror("PETSc error in PCSetReusePreconditioner.",err,error,*999)
4397  ENDIF
4398 
4399  exits("Petsc_PCSetReusePreconditioner")
4400  RETURN
4401 999 errorsexits("Petsc_PCSetReusePreconditioner",err,error)
4402  RETURN 1
4403 
4404  END SUBROUTINE petsc_pcsetreusepreconditioner
4405 
4406  !
4407  !================================================================================================================================
4408  !
4409 
4411  SUBROUTINE petsc_pcsetfromoptions(pc,err,error,*)
4413  !Argument Variables
4414  TYPE(petscpctype), INTENT(INOUT) :: pc
4415  INTEGER(INTG), INTENT(OUT) :: err
4416  TYPE(varying_string), INTENT(OUT) :: error
4417  !Local Variables
4418 
4419  enters("Petsc_PCSetFromOptions",err,error,*999)
4420 
4421  CALL pcsetfromoptions(pc%pc,err)
4422  IF(err/=0) THEN
4423  IF(petschandleerror) THEN
4424  chkerrq(err)
4425  ENDIF
4426  CALL flagerror("PETSc error in PCSetFromOptions.",err,error,*999)
4427  ENDIF
4428 
4429  exits("Petsc_PCSetFromOptions")
4430  RETURN
4431 999 errorsexits("Petsc_PCSetFromOptions",err,error)
4432  RETURN 1
4433 
4434  END SUBROUTINE petsc_pcsetfromoptions
4435 
4436  !
4437  !================================================================================================================================
4438  !
4439 
4441  SUBROUTINE petsc_pcsettype(pc,method,err,error,*)
4443  !Argument Variables
4444  TYPE(petscpctype), INTENT(INOUT) :: pc
4445  pctype, INTENT(IN) :: method
4446  INTEGER(INTG), INTENT(OUT) :: err
4447  TYPE(varying_string), INTENT(OUT) :: error
4448  !Local Variables
4449 
4450  enters("Petsc_PCSetType",err,error,*999)
4451 
4452  CALL pcsettype(pc%pc,method,err)
4453  IF(err/=0) THEN
4454  IF(petschandleerror) THEN
4455  chkerrq(err)
4456  ENDIF
4457  CALL flagerror("PETSc error in PCSetType.",err,error,*999)
4458  ENDIF
4459 
4460  exits("Petsc_PCSetType")
4461  RETURN
4462 999 errorsexits("Petsc_PCSetType",err,error)
4463  RETURN 1
4464 
4465  END SUBROUTINE petsc_pcsettype
4466 
4467  !
4468  !================================================================================================================================
4469  !
4470 
4471  !Finalise the PETSc SNES structure and destroy the SNES
4472  SUBROUTINE petsc_snesfinalise(snes,err,error,*)
4474  !Argument Variables
4475  TYPE(petscsnestype), INTENT(INOUT) :: snes
4476  INTEGER(INTG), INTENT(OUT) :: err
4477  TYPE(varying_string), INTENT(OUT) :: error
4478  !Local Variables
4479 
4480  enters("Petsc_SnesFinalise",err,error,*999)
4481 
4482  IF(snes%snes/=petsc_null_object) THEN
4483  CALL petsc_snesdestroy(snes,err,error,*999)
4484  ENDIF
4485 
4486  exits("Petsc_SnesFinalise")
4487  RETURN
4488 999 errorsexits("Petsc_SnesFinalise",err,error)
4489  RETURN 1
4490 
4491  END SUBROUTINE petsc_snesfinalise
4492 
4493  !
4494  !================================================================================================================================
4495  !
4496 
4497  !Initialise the PETSc SNES structure
4498  SUBROUTINE petsc_snesinitialise(snes,err,error,*)
4500  !Argument Variables
4501  TYPE(petscsnestype), INTENT(INOUT) :: snes
4502  INTEGER(INTG), INTENT(OUT) :: err
4503  TYPE(varying_string), INTENT(OUT) :: error
4504  !Local Variables
4505 
4506  enters("Petsc_SnesInitialise",err,error,*999)
4507 
4508  snes%snes=petsc_null_object
4509 
4510  exits("Petsc_SnesInitialise")
4511  RETURN
4512 999 errorsexits("Petsc_SnesInitialise",err,error)
4513  RETURN 1
4514 
4515  END SUBROUTINE petsc_snesinitialise
4516 
4517 !
4518  !================================================================================================================================
4519  !
4520 
4522  SUBROUTINE petsc_snescomputejacobiandefault(snes,x,j,b,ctx,err,error,*)
4524  !Argument variables
4525  TYPE(petscsnestype), INTENT(INOUT) :: snes
4526  TYPE(petscvectype), INTENT(INOUT) :: x
4527  TYPE(petscmattype), INTENT(INOUT) :: j
4528  TYPE(petscmattype), INTENT(INOUT) :: b
4529  TYPE(solver_type), POINTER :: ctx
4530  INTEGER(INTG), INTENT(INOUT) :: err
4531  TYPE(varying_string), INTENT(OUT) :: error
4532 
4533  enters("Petsc_SnesComputeJacobianDefault",err,error,*999)
4534 
4535  CALL snescomputejacobiandefault(snes%snes,x%vec,j%mat,b%mat,ctx,err)
4536  IF(err/=0) THEN
4537  IF(petschandleerror) THEN
4538  chkerrq(err)
4539  ENDIF
4540  CALL flagerror("PETSc error in SNESComputeJacobianDefault.",err,error,*999)
4541  ENDIF
4542 
4543  exits("Petsc_SnesComputeJacobianDefault")
4544  RETURN
4545 999 errorsexits("Petsc_SnesComputeJacobianDefault",err,error)
4546  RETURN
4547 
4548  END SUBROUTINE petsc_snescomputejacobiandefault
4549 
4550  !
4551  !================================================================================================================================
4552  !
4553 
4555  SUBROUTINE petsc_snescomputejacobiandefaultcolor(snes,x,j,b,ctx,err,error,*)
4557  !Argument variables
4558  TYPE(petscsnestype), INTENT(INOUT) :: snes
4559  TYPE(petscvectype), INTENT(INOUT) :: x
4560  TYPE(petscmattype), INTENT(INOUT) :: j
4561  TYPE(petscmattype), INTENT(INOUT) :: b
4562  TYPE(petscmatfdcoloringtype), POINTER :: ctx
4563  INTEGER(INTG), INTENT(INOUT) :: err
4564  TYPE(varying_string), INTENT(OUT) :: error
4565 
4566  enters("Petsc_SnesComputeJacobianDefaultColor",err,error,*999)
4567 
4568  CALL snescomputejacobiandefaultcolor(snes%snes,x%vec,j%mat,b%mat,ctx,err)
4569  IF(err/=0) THEN
4570  IF(petschandleerror) THEN
4571  chkerrq(err)
4572  ENDIF
4573  CALL flagerror("PETSc error in SNESComputeJacobianDefaultColor.",err,error,*999)
4574  ENDIF
4575 
4576  exits("Petsc_SnesComputeJacobianDefaultColor")
4577  RETURN
4578 999 errorsexits("Petsc_SnesComputeJacobianDefaultColor",err,error)
4579  RETURN
4580 
4582 
4583  !
4584  !================================================================================================================================
4585  !
4586 
4588  SUBROUTINE petsc_snescreate(communicator,snes,err,error,*)
4590  !Argument Variables
4591  mpi_comm, INTENT(IN) :: communicator
4592  TYPE(petscsnestype), INTENT(INOUT) :: snes
4593  INTEGER(INTG), INTENT(OUT) :: err
4594  TYPE(varying_string), INTENT(OUT) :: error
4595  !Local Variables
4596 
4597  enters("Petsc_SnesCreate",err,error,*999)
4598 
4599  CALL snescreate(communicator,snes%snes,err)
4600  IF(err/=0) THEN
4601  IF(petschandleerror) THEN
4602  chkerrq(err)
4603  ENDIF
4604  CALL flagerror("PETSc error in SNESCreate.",err,error,*999)
4605  ENDIF
4606 
4607  exits("Petsc_SnesCreate")
4608  RETURN
4609 999 errorsexits("Petsc_SnesCreate",err,error)
4610  RETURN 1
4611 
4612  END SUBROUTINE petsc_snescreate
4613 
4614  !
4615  !================================================================================================================================
4616  !
4617 
4619  SUBROUTINE petsc_snesdestroy(snes,err,error,*)
4621  !Argument Variables
4622  TYPE(petscsnestype), INTENT(INOUT) :: snes
4623  INTEGER(INTG), INTENT(OUT) :: err
4624  TYPE(varying_string), INTENT(OUT) :: error
4625  !Local Variables
4626 
4627  enters("Petsc_SnesDestroy",err,error,*999)
4628 
4629  CALL snesdestroy(snes%snes,err)
4630  IF(err/=0) THEN
4631  IF(petschandleerror) THEN
4632  chkerrq(err)
4633  ENDIF
4634  CALL flagerror("PETSc error in SNESDestroy.",err,error,*999)
4635  ENDIF
4636  snes%snes=petsc_null_object
4637 
4638  exits("Petsc_SnesDestroy")
4639  RETURN
4640 999 errorsexits("Petsc_SnesDestroy",err,error)
4641  RETURN 1
4642 
4643  END SUBROUTINE petsc_snesdestroy
4644 
4645  !
4646  !================================================================================================================================
4647  !
4648 
4650  SUBROUTINE petsc_snesgetapplicationcontext(snes,ctx,err,error,*)
4652  !Argument Variables
4653  TYPE(petscsnestype), INTENT(INOUT) :: snes
4654  TYPE(solver_type), POINTER :: ctx
4655  INTEGER(INTG), INTENT(OUT) :: err
4656  TYPE(varying_string), INTENT(OUT) :: error
4657  !Local Variables
4658 
4659  enters("Petsc_SnesGetApplicationContext",err,error,*999)
4660 
4661  IF(ASSOCIATED(ctx)) THEN
4662  CALL flagerror("Context is already associated.",err,error,*999)
4663  ELSE
4664  CALL snesgetapplicationcontext(snes%snes,ctx,err)
4665  IF(err/=0) THEN
4666  IF(petschandleerror) THEN
4667  chkerrq(err)
4668  ENDIF
4669  CALL flagerror("PETSc error in SNESGetApplicationContext.",err,error,*999)
4670  ENDIF
4671  ENDIF
4672 
4673  exits("Petsc_SnesGetApplicationContext")
4674  RETURN
4675 999 errorsexits("Petsc_SnesGetApplicationContext",err,error)
4676  RETURN 1
4677 
4678  END SUBROUTINE petsc_snesgetapplicationcontext
4679 
4680  !
4681  !================================================================================================================================
4682  !
4683 
4685  SUBROUTINE petsc_snesgetconvergedreason(snes,reason,err,error,*)
4687  !Argument Variables
4688  TYPE(petscsnestype), INTENT(INOUT) :: snes
4689  INTEGER(INTG), INTENT(OUT) :: reason
4690  INTEGER(INTG), INTENT(OUT) :: err
4691  TYPE(varying_string), INTENT(OUT) :: error
4692  !Local Variables
4693 
4694  enters("Petsc_SnesGetConvergedReason",err,error,*999)
4695 
4696  CALL snesgetconvergedreason(snes%snes,reason,err)
4697  IF(err/=0) THEN
4698  IF(petschandleerror) THEN
4699  chkerrq(err)
4700  ENDIF
4701  CALL flagerror("PETSc error in SNESGetConvergedReason.",err,error,*999)
4702  ENDIF
4703 
4704  exits("Petsc_SnesGetConvergedReason")
4705  RETURN
4706 999 errorsexits("Petsc_SnesGetConvergedReason",err,error)
4707  RETURN 1
4708 
4709  END SUBROUTINE petsc_snesgetconvergedreason
4710 
4711  !
4712  !================================================================================================================================
4713  !
4714 
4716  SUBROUTINE petsc_snesgetfunction(snes,f,err,error,*)
4718  !Argument Variables
4719  TYPE(petscsnestype), INTENT(INOUT) :: snes
4720  TYPE(petscvectype), INTENT(OUT) :: f
4721  INTEGER(INTG), INTENT(OUT) :: err
4722  TYPE(varying_string), INTENT(OUT) :: error
4723  !Local Variables
4724  enters("Petsc_SnesGetFunction",err,error,*999)
4725 
4726  CALL snesgetfunction(snes%snes,f%vec,petsc_null_function,petsc_null_integer,err)
4727  IF(err/=0) THEN
4728  IF(petschandleerror) THEN
4729  chkerrq(err)
4730  ENDIF
4731  CALL flagerror("PETSc error in SNESGetFunction.",err,error,*999)
4732  ENDIF
4733 
4734  exits("Petsc_SnesGetFunction")
4735  RETURN
4736 999 errorsexits("Petsc_SnesGetFunction",err,error)
4737  RETURN 1
4738 
4739  END SUBROUTINE petsc_snesgetfunction
4740 
4741  !
4742  !================================================================================================================================
4743  !
4744 
4746  SUBROUTINE petsc_snesgetiterationnumber(snes,iterationNumber,err,error,*)
4748  !Argument Variables
4749  TYPE(petscsnestype), INTENT(INOUT) :: snes
4750  INTEGER(INTG), INTENT(OUT) :: iterationNumber
4751  INTEGER(INTG), INTENT(OUT) :: err
4752  TYPE(varying_string), INTENT(OUT) :: error
4753  !Local Variables
4754 
4755  enters("Petsc_SnesGetIterationNumber",err,error,*999)
4756 
4757  CALL snesgetiterationnumber(snes%snes,iterationnumber,err)
4758  IF(err/=0) THEN
4759  IF(petschandleerror) THEN
4760  chkerrq(err)
4761  ENDIF
4762  CALL flagerror("PETSc error in SNESGetIterationNumber.",err,error,*999)
4763  ENDIF
4764 
4765  exits("Petsc_SnesGetIterationNumber")
4766  RETURN
4767 999 errorsexits("Petsc_SnesGetIterationNumber",err,error)
4768  RETURN 1
4769 
4770  END SUBROUTINE petsc_snesgetiterationnumber
4771 
4772  !
4773  !================================================================================================================================
4774  !
4775 
4777  SUBROUTINE petsc_snesgetjacobiansolver(snes,a,b,jFunction,err,error,*)
4779  !Argument Variables
4780  TYPE(petscsnestype), INTENT(INOUT) :: snes
4781  TYPE(petscmattype), INTENT(INOUT) :: a
4782  TYPE(petscmattype), INTENT(INOUT) :: b
4783  EXTERNAL jfunction
4784 ! TYPE(SOLVER_TYPE), POINTER :: CTX !<The solver data to pass to the function
4785  INTEGER(INTG), INTENT(OUT) :: err
4786  TYPE(varying_string), INTENT(OUT) :: error
4787  !Local Variables
4788 
4789  enters("Petsc_SnesGetJacobianSolver",err,error,*999)
4790 
4791  CALL snesgetjacobian(snes%snes,a%mat,b%mat,jfunction,petsc_null_integer,err)
4792  IF(err/=0) THEN
4793  IF(petschandleerror) THEN
4794  chkerrq(err)
4795  ENDIF
4796  CALL flagerror("PETSc error in SNESGetJacobian.",err,error,*999)
4797  ENDIF
4798 
4799  exits("Petsc_SnesGetJacobianSolver")
4800  RETURN
4801 999 errorsexits("Petsc_SnesGetJacobianSolver",err,error)
4802  RETURN 1
4803 
4804  END SUBROUTINE petsc_snesgetjacobiansolver
4805 
4806  !
4807  !================================================================================================================================
4808  !
4809 
4811  SUBROUTINE petsc_snesgetjacobianspecial(snes,a,err,error,*)
4813  !Argument Variables
4814  TYPE(petscsnestype), INTENT(INOUT) :: snes
4815  TYPE(petscmattype), INTENT(INOUT) :: a
4816  INTEGER(INTG), INTENT(OUT) :: err
4817  TYPE(varying_string), INTENT(OUT) :: error
4818  !Local Variables
4819 
4820  enters("Petsc_SnesGetJacobianSpecial",err,error,*999)
4821 
4822  CALL snesgetjacobian(snes%snes,a%mat,petsc_null_object,petsc_null_function,petsc_null_integer,err)
4823 
4824  IF(err/=0) THEN
4825  IF(petschandleerror) THEN
4826  chkerrq(err)
4827  ENDIF
4828  CALL flagerror("PETSc error in SNESGetJacobian.",err,error,*999)
4829  ENDIF
4830 
4831  exits("Petsc_SnesGetJacobianSpecial")
4832  RETURN
4833 999 errorsexits("Petsc_SnesGetJacobianSpecial",err,error)
4834  RETURN 1
4835 
4836  END SUBROUTINE petsc_snesgetjacobianspecial
4837 
4838  !
4839  !================================================================================================================================
4840  !
4841 
4843  SUBROUTINE petsc_snesgetksp(snes,ksp,err,error,*)
4845  !Argument Variables
4846  TYPE(petscsnestype), INTENT(INOUT) :: snes
4847  TYPE(petscksptype), INTENT(INOUT) :: ksp
4848  INTEGER(INTG), INTENT(OUT) :: err
4849  TYPE(varying_string), INTENT(OUT) :: error
4850  !Local Variables
4851 
4852  enters("Petsc_SnesGetKSP",err,error,*999)
4853 
4854  CALL snesgetksp(snes%snes,ksp%ksp,err)
4855  IF(err/=0) THEN
4856  IF(petschandleerror) THEN
4857  chkerrq(err)
4858  ENDIF
4859  CALL flagerror("PETSc error in SNESGetKSP.",err,error,*999)
4860  ENDIF
4861 
4862  exits("Petsc_SnesGetKSP")
4863  RETURN
4864 999 errorsexits("Petsc_SnesGetKSP",err,error)
4865  RETURN 1
4866 
4867  END SUBROUTINE petsc_snesgetksp
4868 
4869  !
4870  !================================================================================================================================
4871  !
4872 
4874  SUBROUTINE petsc_snesgetlinesearch(snes,lineSearch,err,error,*)
4876  !Argument Variables
4877  TYPE(petscsnestype), INTENT(INOUT) :: snes
4878  TYPE(petscsneslinesearchtype), INTENT(OUT) :: lineSearch
4879  INTEGER(INTG), INTENT(OUT) :: err
4880  TYPE(varying_string), INTENT(OUT) :: error
4881 
4882  enters("Petsc_SnesGetLineSearch",err,error,*999)
4883 
4884  CALL snesgetlinesearch(snes%snes,linesearch%snesLineSearch,err)
4885  IF(err/=0) THEN
4886  IF(petschandleerror) THEN
4887  chkerrq(err)
4888  ENDIF
4889  CALL flagerror("PETSc error in SNESGetLineSearch.",err,error,*999)
4890  ENDIF
4891 
4892  exits("Petsc_SnesGetLineSearch")
4893  RETURN
4894 999 errorsexits("Petsc_SnesGetLineSearch",err,error)
4895  RETURN 1
4896 
4897  END SUBROUTINE petsc_snesgetlinesearch
4898 
4899  !
4900  !================================================================================================================================
4901  !
4902 
4904  SUBROUTINE petsc_snesgetsolutionupdate(snes,solutionUpdate,err,error,*)
4906  !Argument Variables
4907  TYPE(petscsnestype), INTENT(INOUT) :: snes
4908  TYPE(petscvectype), INTENT(INOUT) :: solutionUpdate
4909  INTEGER(INTG), INTENT(OUT) :: err
4910  TYPE(varying_string), INTENT(OUT) :: error
4911  !Local Variables
4912 
4913  enters("Petsc_SnesGetSolutionUpdate",err,error,*999)
4914 
4915  CALL snesgetsolutionupdate(snes%snes,solutionupdate%vec,err)
4916  IF(err/=0) THEN
4917  IF(petschandleerror) THEN
4918  chkerrq(err)
4919  ENDIF
4920  CALL flagerror("PETSc error in SNESGetSolutionUpdate.",err,error,*999)
4921  ENDIF
4922 
4923  exits("Petsc_SnesGetSolutionUpdate")
4924  RETURN
4925 999 errorsexits("Petsc_SnesGetSolutionUpdate",err,error)
4926  RETURN 1
4927 
4928  END SUBROUTINE petsc_snesgetsolutionupdate
4929 
4930 !
4931  !================================================================================================================================
4932  !
4933 
4935  SUBROUTINE petsc_snesmonitorset(snes,mFunction,ctx,err,error,*)
4937  !Argument Variables
4938  TYPE(petscsnestype), INTENT(INOUT) :: snes
4939  EXTERNAL :: mfunction
4940  TYPE(solver_type), POINTER :: ctx
4941  INTEGER(INTG), INTENT(OUT) :: err
4942  TYPE(varying_string), INTENT(OUT) :: error
4943  !Local Variables
4944 
4945  enters("Petsc_SnesMonitorSet",err,error,*999)
4946 
4947  CALL snesmonitorset(snes%snes,mfunction,ctx,petsc_null_function,err)
4948  IF(err/=0) THEN
4949  IF(petschandleerror) THEN
4950  chkerrq(err)
4951  ENDIF
4952  CALL flagerror("PETSc error in SNESMonitorSet.",err,error,*999)
4953  ENDIF
4954 
4955  exits("Petsc_SnesMonitorSet")
4956  RETURN
4957 999 errorsexits("Petsc_SnesMonitorSet",err,error)
4958  RETURN 1
4959 
4960  END SUBROUTINE petsc_snesmonitorset
4961 
4962  !
4963  !================================================================================================================================
4964  !
4965 
4967  SUBROUTINE petsc_snesqnsetrestarttype(snes,rType,err,error,*)
4969  !Argument Variables
4970  TYPE(petscsnestype), INTENT(INOUT) :: snes
4971  snesqnrestarttype, INTENT(IN) :: rtype
4972  INTEGER(INTG), INTENT(OUT) :: err
4973  TYPE(varying_string), INTENT(OUT) :: error
4974  !Local Variables
4975 
4976  enters("Petsc_SnesQNSetRestartType",err,error,*999)
4977 
4978  CALL snesqnsetrestarttype(snes%snes,rtype,err)
4979  IF(err/=0) THEN
4980  IF(petschandleerror) THEN
4981  chkerrq(err)
4982  ENDIF
4983  CALL flagerror("PETSc error in SNESQNSetRestartType.",err,error,*999)
4984  ENDIF
4985 
4986  exits("Petsc_SnesQNSetRestartType")
4987  RETURN
4988 999 errorsexits("Petsc_SnesQNSetRestartType",err,error)
4989  RETURN 1
4990 
4991  END SUBROUTINE petsc_snesqnsetrestarttype
4992 
4993  !
4994  !================================================================================================================================
4995  !
4996 
4998  SUBROUTINE petsc_snesqnsetscaletype(snes,sType,err,error,*)
5000  !Argument Variables
5001  TYPE(petscsnestype), INTENT(INOUT) :: snes
5002  snesqnscaletype, INTENT(IN) :: stype
5003  INTEGER(INTG), INTENT(OUT) :: err
5004  TYPE(varying_string), INTENT(OUT) :: error
5005  !Local Variables
5006 
5007  enters("Petsc_SnesQNSetScaleType",err,error,*999)
5008 
5009  CALL snesqnsetscaletype(snes%snes,stype,err)
5010  IF(err/=0) THEN
5011  IF(petschandleerror) THEN
5012  chkerrq(err)
5013  ENDIF
5014  CALL flagerror("PETSc error in SNESQNSetScaleType.",err,error,*999)
5015  ENDIF
5016 
5017  exits("Petsc_SnesQNSetScaleType")
5018  RETURN
5019 999 errorsexits("Petsc_SnesQNSetScaleType",err,error)
5020  RETURN 1
5021 
5022  END SUBROUTINE petsc_snesqnsetscaletype
5023 
5024  !
5025  !================================================================================================================================
5026  !
5027 
5029  SUBROUTINE petsc_snesqnsettype(snes,qType,err,error,*)
5031  !Argument Variables
5032  TYPE(petscsnestype), INTENT(INOUT) :: snes
5033  snesqntype, INTENT(IN) :: qtype
5034  INTEGER(INTG), INTENT(OUT) :: err
5035  TYPE(varying_string), INTENT(OUT) :: error
5036  !Local Variables
5037 
5038  enters("Petsc_SnesQNSetType",err,error,*999)
5039 
5040  CALL snesqnsettype(snes%snes,qtype,err)
5041  IF(err/=0) THEN
5042  IF(petschandleerror) THEN
5043  chkerrq(err)
5044  ENDIF
5045  CALL flagerror("PETSc error in SNESQNSetType.",err,error,*999)
5046  ENDIF
5047 
5048  exits("Petsc_SnesQNSetType")
5049  RETURN
5050 999 errorsexits("Petsc_SnesQNSetType",err,error)
5051  RETURN 1
5052 
5053  END SUBROUTINE petsc_snesqnsettype
5054 
5055  !
5056  !================================================================================================================================
5057  !
5058 
5060  SUBROUTINE petsc_snessetapplicationcontext(snes,ctx,err,error,*)
5062  !Argument Variables
5063  TYPE(petscsnestype), INTENT(INOUT) :: snes
5064  TYPE(solver_type), POINTER :: ctx
5065  INTEGER(INTG), INTENT(OUT) :: err
5066  TYPE(varying_string), INTENT(OUT) :: error
5067  !Local Variables
5068 
5069  enters("Petsc_SnesSetApplicationContext",err,error,*999)
5070 
5071  CALL snessetapplicationcontext(snes%snes,ctx,err)
5072  IF(err/=0) THEN
5073  IF(petschandleerror) THEN
5074  chkerrq(err)
5075  ENDIF
5076  CALL flagerror("PETSc error in SNESSetApplicationContext.",err,error,*999)
5077  ENDIF
5078 
5079  exits("Petsc_SnesSetApplicationContext")
5080  RETURN
5081 999 errorsexits("Petsc_SnesSetApplicationContext",err,error)
5082  RETURN 1
5083 
5084  END SUBROUTINE petsc_snessetapplicationcontext
5085 
5086  !
5087  !================================================================================================================================
5088  !
5089 
5091  SUBROUTINE petsc_snessetconvergencetest(snes,cFunction,ctx,err,error,*)
5092  !Argument Variables
5093  TYPE(petscsnestype), INTENT(INOUT) :: snes
5094  EXTERNAL cfunction
5095  TYPE(solver_type), POINTER :: ctx
5096  INTEGER(INTG), INTENT(OUT) :: err
5097  TYPE(varying_string), INTENT(OUT) :: error
5098  !Local Variables
5099 
5100  enters("Petsc_SnesSetConvergenceTest",err,error,*999)
5101 
5102  CALL snessetconvergencetest(snes%snes,cfunction,ctx,petsc_null_function,err)
5103  IF(err/=0) THEN
5104  IF(petschandleerror) THEN
5105  chkerrq(err)
5106  ENDIF
5107  CALL flagerror("PETSc error in SNESSetConvergenceTest.",err,error,*999)
5108  ENDIF
5109 
5110  exits("Petsc_SnesSetConvergenceTest")
5111  RETURN
5112 999 errorsexits("Petsc_SnesSetConvergenceTest",err,error)
5113  RETURN 1
5114 
5115  END SUBROUTINE petsc_snessetconvergencetest
5116 
5117  !
5118  !================================================================================================================================
5119  !
5120 
5122  SUBROUTINE petsc_snessetfromoptions(snes,err,error,*)
5124  !Argument Variables
5125  TYPE(petscsnestype), INTENT(INOUT) :: snes
5126  INTEGER(INTG), INTENT(OUT) :: err
5127  TYPE(varying_string), INTENT(OUT) :: error
5128  !Local Variables
5129 
5130  enters("Petsc_SnesSetFromOptions",err,error,*999)
5131 
5132  CALL snessetfromoptions(snes%snes,err)
5133  IF(err/=0) THEN
5134  IF(petschandleerror) THEN
5135  chkerrq(err)
5136  ENDIF
5137  CALL flagerror("PETSc error in SNESSetFromOptions.",err,error,*999)
5138  ENDIF
5139 
5140  exits("Petsc_SnesSetFromOptions")
5141  RETURN
5142 999 errorsexits("Petsc_SnesSetFromOptions",err,error)
5143  RETURN 1
5144 
5145  END SUBROUTINE petsc_snessetfromoptions
5146 
5147  !
5148  !================================================================================================================================
5149  !
5150 
5152  SUBROUTINE petsc_snessetfunction(snes,f,fFunction,ctx,err,error,*)
5154  !Argument Variables
5155  TYPE(petscsnestype), INTENT(INOUT) :: snes
5156  TYPE(petscvectype), INTENT(INOUT) :: f
5157  EXTERNAL ffunction
5158  TYPE(solver_type), POINTER :: ctx
5159  INTEGER(INTG), INTENT(OUT) :: err
5160  TYPE(varying_string), INTENT(OUT) :: error
5161  !Local Variables
5162 
5163  enters("Petsc_SnesSetFunction",err,error,*999)
5164 
5165  CALL snessetfunction(snes%snes,f%vec,ffunction,ctx,err)
5166  IF(err/=0) THEN
5167  IF(petschandleerror) THEN
5168  chkerrq(err)
5169  ENDIF
5170  CALL flagerror("PETSc error in SNESSetFunction.",err,error,*999)
5171  ENDIF
5172 
5173  exits("Petsc_SnesSetFunction")
5174  RETURN
5175 999 errorsexits("Petsc_SnesSetFunction",err,error)
5176  RETURN 1
5177 
5178  END SUBROUTINE petsc_snessetfunction
5179 
5180  !
5181  !================================================================================================================================
5182  !
5183 
5185  SUBROUTINE petsc_snessetjacobianmatfdcoloring(snes,a,b,jFunction,ctx,err,error,*)
5187  !Argument Variables
5188  TYPE(petscsnestype), INTENT(INOUT) :: snes
5189  TYPE(petscmattype), INTENT(INOUT) :: a
5190  TYPE(petscmattype), INTENT(INOUT) :: b
5191  EXTERNAL jfunction
5192  TYPE(petscmatfdcoloringtype) :: ctx
5193  INTEGER(INTG), INTENT(OUT) :: err
5194  TYPE(varying_string), INTENT(OUT) :: error
5195  !Local Variables
5196 
5197  enters("Petsc_SnesSetJacobianMatFDColoring",err,error,*999)
5198 
5199  CALL snessetjacobianbuffer(snes,a,b,jfunction,ctx,err)
5200  IF(err/=0) THEN
5201  IF(petschandleerror) THEN
5202  chkerrq(err)
5203  ENDIF
5204  CALL flagerror("PETSc error in SNESSetJacobian.",err,error,*999)
5205  ENDIF
5206 
5207  exits("Petsc_SnesSetJacobianMatFDColoring")
5208  RETURN
5209 999 errorsexits("Petsc_SnesSetJacobianMatFDColoring",err,error)
5210  RETURN 1
5211 
5212  END SUBROUTINE petsc_snessetjacobianmatfdcoloring
5213 
5214  !
5215  !================================================================================================================================
5216  !
5217 
5219  SUBROUTINE petsc_snessetjacobiansolver(snes,a,b,jFunction,ctx,err,error,*)
5221  !Argument Variables
5222  TYPE(petscsnestype), INTENT(INOUT) :: snes
5223  TYPE(petscmattype), INTENT(INOUT) :: a
5224  TYPE(petscmattype), INTENT(INOUT) :: b
5225  EXTERNAL jfunction
5226  TYPE(solver_type), POINTER :: ctx
5227  INTEGER(INTG), INTENT(OUT) :: err
5228  TYPE(varying_string), INTENT(OUT) :: error
5229  !Local Variables
5230 
5231  enters("Petsc_SnesSetJacobianSolver",err,error,*999)
5232 
5233  CALL snessetjacobian(snes%snes,a%mat,b%mat,jfunction,ctx,err)
5234  IF(err/=0) THEN
5235  IF(petschandleerror) THEN
5236  chkerrq(err)
5237  ENDIF
5238  CALL flagerror("PETSc error in SNESSetJacobian.",err,error,*999)
5239  ENDIF
5240 
5241  exits("Petsc_SnesSetJacobianSolver")
5242  RETURN
5243 999 errorsexits("Petsc_SnesSetJacobianSolver",err,error)
5244  RETURN 1
5245 
5246  END SUBROUTINE petsc_snessetjacobiansolver
5247 
5248  !
5249  !================================================================================================================================
5250  !
5251 
5253  SUBROUTINE petsc_snessetksp(snes,ksp,err,error,*)
5255  !Argument Variables
5256  TYPE(petscsnestype), INTENT(INOUT) :: snes
5257  TYPE(petscksptype), INTENT(INOUT) :: ksp
5258  INTEGER(INTG), INTENT(OUT) :: err
5259  TYPE(varying_string), INTENT(OUT) :: error
5260  !Local Variables
5261 
5262  enters("Petsc_SnesSetKsp",err,error,*999)
5263 
5264  CALL snessetksp(snes%snes,ksp%ksp,err)
5265  IF(err/=0) THEN
5266  IF(petschandleerror) THEN
5267  chkerrq(err)
5268  ENDIF
5269  CALL flagerror("PETSc error in SNESSetKSP.",err,error,*999)
5270  ENDIF
5271 
5272  exits("Petsc_SnesSetKsp")
5273  RETURN
5274 999 errorsexits("Petsc_SnesSetKsp",err,error)
5275  RETURN 1
5276 
5277  END SUBROUTINE petsc_snessetksp
5278 
5279  !
5280  !================================================================================================================================
5281  !
5282 
5284  SUBROUTINE petsc_snessetnormschedule(snes,normSchedule,err,error,*)
5286  !Argument Variables
5287  TYPE(petscsnestype), INTENT(INOUT) :: snes
5288  snesnormschedule, INTENT(IN) :: normschedule
5289  INTEGER(INTG), INTENT(OUT) :: err
5290  TYPE(varying_string), INTENT(OUT) :: error
5291  !Local Variables
5292 
5293  enters("Petsc_SnesSetNormSchedule",err,error,*999)
5294 
5295  CALL snessetnormschedule(snes%snes,normschedule,err)
5296  IF(err/=0) THEN
5297  IF(petschandleerror) THEN
5298  chkerrq(err)
5299  ENDIF
5300  CALL flagerror("PETSc error in SNESSetNormSchedule.",err,error,*999)
5301  ENDIF
5302 
5303  exits("Petsc_SnesSetNormSchedule")
5304  RETURN
5305 999 errorsexits("Petsc_SnesSetNormSchedule",err,error)
5306  RETURN 1
5307 
5308  END SUBROUTINE petsc_snessetnormschedule
5309 
5310  !
5311  !================================================================================================================================
5312  !
5313 
5315  SUBROUTINE petsc_snessettolerances(snes,absTol,rTol,sTol,maxIterations,maxFunctionEvals,err,error,*)
5317  !Argument Variables
5318  TYPE(petscsnestype), INTENT(INOUT) :: snes
5319  REAL(DP), INTENT(IN) :: absTol
5320  REAL(DP), INTENT(IN) :: rTol
5321  REAL(DP), INTENT(IN) :: sTol
5322  INTEGER(INTG), INTENT(IN) :: maxIterations
5323  INTEGER(INTG), INTENT(IN) :: maxFunctionEvals
5324  INTEGER(INTG), INTENT(OUT) :: err
5325  TYPE(varying_string), INTENT(OUT) :: error
5326  !Local Variables
5327 
5328  enters("Petsc_SnesSetTolerances",err,error,*999)
5329 
5330  CALL snessettolerances(snes%snes,abstol,rtol,stol,maxiterations,maxfunctionevals,err)
5331  IF(err/=0) THEN
5332  IF(petschandleerror) THEN
5333  chkerrq(err)
5334  ENDIF
5335  CALL flagerror("PETSc error in SNESSetTolerances.",err,error,*999)
5336  ENDIF
5337 
5338  exits("Petsc_SnesSetTolerances")
5339  RETURN
5340 999 errorsexits("Petsc_SnesSetTolerances",err,error)
5341  RETURN 1
5342 
5343  END SUBROUTINE petsc_snessettolerances
5344 
5345  !
5346  !================================================================================================================================
5347  !
5348 
5350  SUBROUTINE petsc_snessettrustregiontolerance(snes,trTol,err,error,*)
5352  !Argument Variables
5353  TYPE(petscsnestype), INTENT(INOUT) :: snes
5354  REAL(DP), INTENT(IN) :: trTol
5355  INTEGER(INTG), INTENT(OUT) :: err
5356  TYPE(varying_string), INTENT(OUT) :: error
5357  !Local Variables
5358 
5359  enters("Petsc_SnesSetTrustRegionTolerance",err,error,*999)
5360 
5361  CALL snessettrustregiontolerance(snes%snes,trtol,err)
5362  IF(err/=0) THEN
5363  IF(petschandleerror) THEN
5364  chkerrq(err)
5365  ENDIF
5366  CALL flagerror("PETSc error in SNESSetTrustRegionTolerance.",err,error,*999)
5367  ENDIF
5368 
5369  exits("Petsc_SnesSetTrustRegionTolerance")
5370  RETURN
5371 999 errorsexits("Petsc_SnesSetTrustRegionTolerance",err,error)
5372  RETURN 1
5373 
5374  END SUBROUTINE petsc_snessettrustregiontolerance
5375 
5376  !
5377  !================================================================================================================================
5378  !
5379 
5381  SUBROUTINE petsc_snessettype(snes,method,err,error,*)
5383  !Argument Variables
5384  TYPE(petscsnestype), INTENT(INOUT) :: snes
5385  snestype, INTENT(IN) :: method
5386  INTEGER(INTG), INTENT(OUT) :: err
5387  TYPE(varying_string), INTENT(OUT) :: error
5388  !Local Variables
5389 
5390  enters("Petsc_SnesSetType",err,error,*999)
5391 
5392  CALL snessettype(snes%snes,method,err)
5393  IF(err/=0) THEN
5394  IF(petschandleerror) THEN
5395  chkerrq(err)
5396  ENDIF
5397  CALL flagerror("PETSc error in SNESSetType.",err,error,*999)
5398  ENDIF
5399 
5400  exits("Petsc_SnesSetType")
5401  RETURN
5402 999 errorsexits("Petsc_SnesSetType",err,error)
5403  RETURN 1
5404 
5405  END SUBROUTINE petsc_snessettype
5406 
5407  !
5408  !================================================================================================================================
5409  !
5410 
5412  SUBROUTINE petsc_snessolve(snes,b,x,err,error,*)
5414  !Argument Variables
5415  TYPE(petscsnestype), INTENT(INOUT) :: snes
5416  TYPE(petscvectype), INTENT(INOUT) :: b
5417  TYPE(petscvectype), INTENT(INOUT) :: x
5418  INTEGER(INTG), INTENT(OUT) :: err
5419  TYPE(varying_string), INTENT(OUT) :: error
5420  !Local Variables
5421 
5422  enters("Petsc_SnesSolve",err,error,*999)
5423 
5424  CALL snessolve(snes%snes,b%vec,x%vec,err)
5425  IF(err/=0) THEN
5426  IF(petschandleerror) THEN
5427  chkerrq(err)
5428  ENDIF
5429  CALL flagerror("PETSc error in SNESSolve.",err,error,*999)
5430  ENDIF
5431 
5432  exits("Petsc_SnesSolve")
5433  RETURN
5434 999 errorsexits("Petsc_SnesSolve",err,error)
5435  RETURN 1
5436 
5437  END SUBROUTINE petsc_snessolve
5438 
5439  !
5440  !================================================================================================================================
5441  !
5442 
5443  !Finalise the PETSc SNES line search structure
5444  SUBROUTINE petsc_sneslinesearchfinalise(lineSearch,err,error,*)
5446  !Argument Variables
5447  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5448  INTEGER(INTG), INTENT(OUT) :: err
5449  TYPE(varying_string), INTENT(OUT) :: error
5450 
5451  enters("Petsc_SnesLineSearchFinalise",err,error,*999)
5452 
5453  !We don't actually call PETSc's SNESLineSearchDestroy as PETSc accesses and destroys the LineSearch when calling
5454  !SNESDestroy, so we'll just let PETSc clean it up.
5455  linesearch%snesLineSearch=petsc_null_object
5456 
5457  exits("Petsc_SnesLineSearchFinalise")
5458  RETURN
5459 999 errorsexits("Petsc_SnesLineSearchFinalise",err,error)
5460  RETURN 1
5461 
5462  END SUBROUTINE petsc_sneslinesearchfinalise
5463 
5464  !
5465  !================================================================================================================================
5466  !
5467 
5468  !Initialise the PETSc SNES line search structure
5469  SUBROUTINE petsc_sneslinesearchinitialise(lineSearch,err,error,*)
5471  !Argument Variables
5472  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5473  INTEGER(INTG), INTENT(OUT) :: err
5474  TYPE(varying_string), INTENT(OUT) :: error
5475  !Local Variables
5476 
5477  enters("Petsc_SnesLineSearchInitialise",err,error,*999)
5478  linesearch%snesLineSearch=petsc_null_object
5479  exits("Petsc_SnesLineSearchInitialise")
5480 
5481  RETURN
5482 999 errorsexits("Petsc_SnesLineSearchInitialise",err,error)
5483  RETURN 1
5484  END SUBROUTINE petsc_sneslinesearchinitialise
5485 
5486  !
5487  !================================================================================================================================
5488  !
5489 
5491  SUBROUTINE petsc_sneslinesearchbtsetalpha(lineSearch,alpha,err,error,*)
5493  !Argument variables
5494  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5495  REAL(DP), INTENT(IN) :: alpha
5496  INTEGER(INTG), INTENT(OUT) :: err
5497  TYPE(varying_string), INTENT(OUT) :: error
5498 
5499  enters("Petsc_SnesLineSearchBTSetAlpha",err,error,*999)
5500 
5501  CALL sneslinesearchbtsetalpha(linesearch%snesLineSearch,alpha,err)
5502  IF(err/=0) THEN
5503  IF(petschandleerror) THEN
5504  chkerrq(err)
5505  END IF
5506  CALL flagerror("PETSc error in SNESLineSearchBTSetAlpha.",err,error,*999)
5507  END IF
5508 
5509  exits("Petsc_SnesLineSearchBTSetAlpha")
5510  RETURN
5511 999 errorsexits("Petsc_SnesLineSearchBTSetAlpha",err,error)
5512  RETURN 1
5513 
5514  END SUBROUTINE petsc_sneslinesearchbtsetalpha
5515 
5516  !
5517  !================================================================================================================================
5518  !
5519 
5521  SUBROUTINE petsc_sneslinesearchcomputenorms(lineSearch,err,error,*)
5523  !Argument Variables
5524  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5525  INTEGER(INTG), INTENT(OUT) :: err
5526  TYPE(varying_string), INTENT(OUT) :: error
5527  !Local Variables
5528 
5529  enters("Petsc_SnesLineSearchComputeNorms",err,error,*999)
5530 
5531  CALL sneslinesearchcomputenorms(linesearch%snesLineSearch,err)
5532  IF(err/=0) THEN
5533  IF(petschandleerror) THEN
5534  chkerrq(err)
5535  ENDIF
5536  CALL flagerror("PETSc error in SnesLineSearchComputeNorms.",err,error,*999)
5537  ENDIF
5538 
5539  exits("Petsc_SnesLineSearchComputeNorms")
5540  RETURN
5541 999 errorsexits("Petsc_SnesLineSearchComputeNorms",err,error)
5542  RETURN 1
5543 
5544  END SUBROUTINE petsc_sneslinesearchcomputenorms
5545 
5546  !
5547  !================================================================================================================================
5548  !
5549 
5551  SUBROUTINE petsc_sneslinesearchgetnorms(lineSearch,xNorm,fNorm,yNorm,err,error,*)
5553  !Argument Variables
5554  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5555  REAL(DP), INTENT(INOUT) :: xNorm
5556  REAL(DP), INTENT(INOUT) :: fNorm
5557  REAL(DP), INTENT(INOUT) :: yNorm
5558  INTEGER(INTG), INTENT(OUT) :: err
5559  TYPE(varying_string), INTENT(OUT) :: error
5560  !Local Variables
5561 
5562  enters("Petsc_SnesLineSearchGetNorms",err,error,*999)
5563 
5564  CALL sneslinesearchgetnorms(linesearch%snesLineSearch,xnorm,fnorm,ynorm,err)
5565  IF(err/=0) THEN
5566  IF(petschandleerror) THEN
5567  chkerrq(err)
5568  ENDIF
5569  CALL flagerror("PETSc error in SnesLineSearchGetNorms.",err,error,*999)
5570  ENDIF
5571 
5572  exits("Petsc_SnesLineSearchGetNorms")
5573  RETURN
5574 999 errorsexits("Petsc_SnesLineSearchGetNorms",err,error)
5575  RETURN 1
5576 
5577  END SUBROUTINE petsc_sneslinesearchgetnorms
5578 
5579  !
5580  !================================================================================================================================
5581  !
5582 
5584  SUBROUTINE petsc_sneslinesearchgetvecs(lineSearch,x,f,y,w,g,err,error,*)
5586  !Argument Variables
5587  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5588  TYPE(petscvectype), INTENT(INOUT) :: x
5589  TYPE(petscvectype), INTENT(INOUT) :: f
5590  TYPE(petscvectype), INTENT(INOUT) :: y
5591  TYPE(petscvectype), INTENT(INOUT) :: w
5592  TYPE(petscvectype), INTENT(INOUT) :: g
5593  INTEGER(INTG), INTENT(OUT) :: err
5594  TYPE(varying_string), INTENT(OUT) :: error
5595  !Local Variables
5596 
5597  enters("Petsc_SnesLineSearchGetVecs",err,error,*999)
5598 
5599  CALL sneslinesearchgetvecs(linesearch%snesLineSearch,x%vec,f%vec,y%vec,w%vec,g%vec,err)
5600  IF(err/=0) THEN
5601  IF(petschandleerror) THEN
5602  chkerrq(err)
5603  ENDIF
5604  CALL flagerror("PETSc error in SNESLineSearchGetVecs.",err,error,*999)
5605  ENDIF
5606 
5607  exits("Petsc_SnesLineSearchGetVecs")
5608  RETURN
5609 999 errorsexits("Petsc_SnesLineSearchGetVecs",err,error)
5610  RETURN 1
5611 
5612  END SUBROUTINE petsc_sneslinesearchgetvecs
5613 
5614  !
5615  !================================================================================================================================
5616  !
5617 
5619  SUBROUTINE petsc_sneslinesearchsetcomputenorms(lineSearch,computeNorms,err,error,*)
5621  !Argument Variables
5622  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5623  LOGICAL, INTENT(IN) :: computeNorms
5624  INTEGER(INTG), INTENT(OUT) :: err
5625  TYPE(varying_string), INTENT(OUT) :: error
5626  !Local Variables
5627 
5628  enters("Petsc_SnesLineSearchSetComputeNorms",err,error,*999)
5629 
5630  IF(computenorms) THEN
5631  CALL sneslinesearchsetcomputenorms(linesearch%snesLineSearch,petsc_true,err)
5632  ELSE
5633  CALL sneslinesearchsetcomputenorms(linesearch%snesLineSearch,petsc_false,err)
5634  ENDIF
5635  IF(err/=0) THEN
5636  IF(petschandleerror) THEN
5637  chkerrq(err)
5638  ENDIF
5639  CALL flagerror("PETSc error in SNESLineSearchSetComputeNorms.",err,error,*999)
5640  ENDIF
5641 
5642  exits("Petsc_SnesLineSearchSetComputeNorms")
5643  RETURN
5644 999 errorsexits("Petsc_SnesLineSearchSetComputeNorms",err,error)
5645  RETURN 1
5646 
5648 
5649  !
5650  !================================================================================================================================
5651  !
5652 
5654  SUBROUTINE petsc_sneslinesearchsetmonitor(lineSearch,monitorLinesearch,err,error,*)
5656  !Argument Variables
5657  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5658  LOGICAL, INTENT(IN) :: monitorLinesearch
5659  INTEGER(INTG), INTENT(OUT) :: err
5660  TYPE(varying_string), INTENT(OUT) :: error
5661  !Local Variables
5662 
5663  enters("Petsc_SnesLineSearchSetMonitor",err,error,*999)
5664 
5665  IF(monitorlinesearch) THEN
5666  CALL sneslinesearchsetmonitor(linesearch%snesLineSearch,petsc_true,err)
5667  ELSE
5668  CALL sneslinesearchsetmonitor(linesearch%snesLineSearch,petsc_false,err)
5669  ENDIF
5670  IF(err/=0) THEN
5671  IF(petschandleerror) THEN
5672  chkerrq(err)
5673  ENDIF
5674  CALL flagerror("PETSc error in SNESLineSearchSetMonitor.",err,error,*999)
5675  ENDIF
5676 
5677  exits("Petsc_SnesLineSearchSetMonitor")
5678  RETURN
5679 999 errorsexits("Petsc_SnesLineSearchSetMonitor",err,error)
5680  RETURN 1
5681 
5682  END SUBROUTINE petsc_sneslinesearchsetmonitor
5683 
5684  !
5685  !================================================================================================================================
5686  !
5687 
5689  SUBROUTINE petsc_sneslinesearchsetnorms(snes,xNorm,fNorm,yNorm,err,error,*)
5691  !Argument Variables
5692  TYPE(petscsnestype), INTENT(INOUT) :: snes
5693  REAL(DP), INTENT(INOUT) :: xNorm
5694  REAL(DP), INTENT(INOUT) :: fNorm
5695  REAL(DP), INTENT(INOUT) :: yNorm
5696  INTEGER(INTG), INTENT(OUT) :: err
5697  TYPE(varying_string), INTENT(OUT) :: error
5698  !Local Variables
5699 
5700  enters("Petsc_SnesLineSearchSetNorms",err,error,*999)
5701 
5702  CALL sneslinesearchsetnorms(snes%snes,xnorm,fnorm,ynorm,err)
5703  IF(err/=0) THEN
5704  IF(petschandleerror) THEN
5705  chkerrq(err)
5706  ENDIF
5707  CALL flagerror("petsc error in SnesLineSearchSetNorms.",err,error,*999)
5708  ENDIF
5709 
5710  exits("Petsc_SnesLineSearchSetNorms")
5711  RETURN
5712 999 errorsexits("Petsc_SnesLineSearchSetNorms",err,error)
5713  RETURN 1
5714 
5715  END SUBROUTINE petsc_sneslinesearchsetnorms
5716 
5717  !
5718  !================================================================================================================================
5719  !
5721  SUBROUTINE petsc_sneslinesearchsetorder(lineSearch,lineSearchOrder,err,error,*)
5723  !Argument Variables
5724  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5725  sneslinesearchorder, INTENT(IN) :: linesearchorder
5726  INTEGER(INTG), INTENT(OUT) :: err
5727  TYPE(varying_string), INTENT(OUT) :: error
5728  !Local Variables
5729  TYPE(varying_string) :: localError
5730 
5731  enters("Petsc_SnesLineSearchSetOrder",err,error,*999)
5732 
5733  SELECT CASE(linesearchorder)
5734  CASE(petsc_snes_linesearch_order_linear)
5735  CALL sneslinesearchsetorder(linesearch%snesLineSearch,snes_linesearch_order_linear,err)
5736  CASE(petsc_snes_linesearch_order_quadratic)
5737  CALL sneslinesearchsetorder(linesearch%snesLineSearch,snes_linesearch_order_quadratic,err)
5738  CASE(petsc_snes_linesearch_order_cubic)
5739  CALL sneslinesearchsetorder(linesearch%snesLineSearch,snes_linesearch_order_cubic,err)
5740  CASE DEFAULT
5741  localerror="The specified line search order of "//trim(numbertovstring(linesearchorder,"*",err,error))//" is invalid."
5742  CALL flagerror(localerror,err,error,*999)
5743  END SELECT
5744  IF(err/=0) THEN
5745  IF(petschandleerror) THEN
5746  chkerrq(err)
5747  ENDIF
5748  CALL flagerror("PETSc error in SNESLineSearchSetOrder.",err,error,*999)
5749  ENDIF
5750 
5751  exits("Petsc_SnesLineSearchSetOrder")
5752  RETURN
5753 999 errorsexits("Petsc_SnesLineSearchSetOrder",err,error)
5754  RETURN 1
5755  END SUBROUTINE petsc_sneslinesearchsetorder
5756 
5757  !
5758  !================================================================================================================================
5759  !
5760 
5762  SUBROUTINE petsc_sneslinesearchsettolerances(lineSearch,steptol,maxstep,rtol,atol,ltol,maxIt,err,error,*)
5764  !Argument variables
5765  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5766  REAL(DP), INTENT(IN) :: steptol
5767  REAL(DP), INTENT(IN) :: maxstep
5768  REAL(DP), INTENT(IN) :: rtol
5769  REAL(DP), INTENT(IN) :: atol
5770  REAL(DP), INTENT(IN) :: ltol
5771  INTEGER(INTG), INTENT(IN) :: maxIt
5772  INTEGER(INTG), INTENT(OUT) :: err
5773  TYPE(varying_string), INTENT(OUT) :: error
5774 
5775  enters("Petsc_SnesLineSearchSetTolerances",err,error,*999)
5776 
5777  CALL sneslinesearchsettolerances(linesearch%snesLineSearch,steptol,maxstep,rtol,atol,ltol,maxit,err)
5778  IF(err/=0) THEN
5779  IF(petschandleerror) THEN
5780  chkerrq(err)
5781  END IF
5782  CALL flagerror("PETSc error in SNESLineSearchSetTolerances.",err,error,*999)
5783  END IF
5784 
5785  exits("Petsc_SnesLineSearchSetTolerances")
5786  RETURN
5787 999 errorsexits("Petsc_SnesLineSearchSetTolerances",err,error)
5788  RETURN 1
5789 
5790  END SUBROUTINE petsc_sneslinesearchsettolerances
5791 
5792  !
5793  !================================================================================================================================
5794  !
5795 
5797  SUBROUTINE petsc_sneslinesearchsettype(lineSearch,lineSearchType,err,error,*)
5799  !Argument Variables
5800  TYPE(petscsneslinesearchtype), INTENT(INOUT) :: lineSearch
5801  sneslinesearchtype, INTENT(IN) :: linesearchtype
5802  INTEGER(INTG), INTENT(OUT) :: err
5803  TYPE(varying_string), INTENT(OUT) :: error
5804 
5805  enters("Petsc_SnesLineSearchSetType",err,error,*999)
5806 
5807  CALL sneslinesearchsettype(linesearch%snesLineSearch,linesearchtype,err)
5808  IF(err/=0) THEN
5809  IF(petschandleerror) THEN
5810  chkerrq(err)
5811  ENDIF
5812  CALL flagerror("PETSc error in SNESLineSearchSetType.",err,error,*999)
5813  ENDIF
5814 
5815  exits("Petsc_SnesLineSearchSetType")
5816  RETURN
5817 999 errorsexits("Petsc_SnesLineSearchSetType",err,error)
5818  RETURN 1
5819 
5820  END SUBROUTINE petsc_sneslinesearchsettype
5821 
5822  !
5823  !================================================================================================================================
5824  !
5825 
5826  !Finalise the PETSc TS structure and destroy the TS
5827  SUBROUTINE petsc_tsfinalise(ts,err,error,*)
5829  !Argument Variables
5830  TYPE(petsctstype), INTENT(INOUT) :: ts
5831  INTEGER(INTG), INTENT(OUT) :: err
5832  TYPE(varying_string), INTENT(OUT) :: error
5833  !Local Variables
5834 
5835  enters("Petsc_TSFinalise",err,error,*999)
5836 
5837  IF(ts%ts/=petsc_null_object) THEN
5838  CALL petsc_tsdestroy(ts,err,error,*999)
5839  ENDIF
5840 
5841  exits("Petsc_TSFinalise")
5842  RETURN
5843 999 errorsexits("Petsc_TSFinalise",err,error)
5844  RETURN 1
5845 
5846  END SUBROUTINE petsc_tsfinalise
5847 
5848  !
5849  !================================================================================================================================
5850  !
5851 
5852  !Initialise the PETSc TS structure
5853  SUBROUTINE petsc_tsinitialise(ts,err,error,*)
5855  !Argument Variables
5856  TYPE(petsctstype), INTENT(INOUT) :: ts
5857  INTEGER(INTG), INTENT(OUT) :: err
5858  TYPE(varying_string), INTENT(OUT) :: error
5859  !Local Variables
5860 
5861  enters("Petsc_TSInitialise",err,error,*999)
5862 
5863  ts%ts=petsc_null_object
5864 
5865  exits("Petsc_TSInitialise")
5866  RETURN
5867 999 errorsexits("Petsc_TSInitialise",err,error)
5868  RETURN 1
5869 
5870  END SUBROUTINE petsc_tsinitialise
5871 
5872  !
5873  !================================================================================================================================
5874  !
5875 
5877  SUBROUTINE petsc_tscreate(communicator,ts,err,error,*)
5879  !Argument Variables
5880  mpi_comm, INTENT(INOUT) :: communicator
5881  TYPE(petsctstype), INTENT(INOUT) :: ts
5882  INTEGER(INTG), INTENT(OUT) :: err
5883  TYPE(varying_string), INTENT(OUT) :: error
5884  !Local Variables
5885 
5886  enters("Petsc_TSCreate",err,error,*999)
5887 
5888  CALL tscreate(communicator,ts%ts,err)
5889  IF(err/=0) THEN
5890  IF(petschandleerror) THEN
5891  chkerrq(err)
5892  ENDIF
5893  CALL flagerror("PETSc error in TSCreate.",err,error,*999)
5894  ENDIF
5895 
5896  exits("Petsc_TSCreate")
5897  RETURN
5898 999 errorsexits("Petsc_TSCreate",err,error)
5899  RETURN 1
5900 
5901  END SUBROUTINE petsc_tscreate
5902 
5903  !
5904  !================================================================================================================================
5905  !
5906 
5908  SUBROUTINE petsc_tsdestroy(ts,err,error,*)
5910  TYPE(petsctstype), INTENT(INOUT) :: ts
5911  INTEGER(INTG), INTENT(OUT) :: err
5912  TYPE(varying_string), INTENT(OUT) :: error
5913  !Local Variables
5914 
5915  enters("Petsc_TSDestroy",err,error,*999)
5916 
5917  CALL tsdestroy(ts%ts,err)
5918  IF(err/=0) THEN
5919  IF(petschandleerror) THEN
5920  chkerrq(err)
5921  ENDIF
5922  CALL flagerror("PETSc error in TSDestroy.",err,error,*999)
5923  ENDIF
5924  ts%ts=petsc_null_object
5925 
5926  exits("Petsc_TSDestroy")
5927  RETURN
5928 999 errorsexits("Petsc_TSDestroy",err,error)
5929  RETURN 1
5930 
5931  END SUBROUTINE petsc_tsdestroy
5932 
5933  !
5934  !================================================================================================================================
5935  !
5936 
5938  SUBROUTINE petsc_tsgetsolution(ts,currentSolution,err,error,*)
5940  TYPE(petsctstype), INTENT(INOUT) :: ts
5941  TYPE(petscvectype), INTENT(INOUT) :: currentSolution
5942  INTEGER(INTG), INTENT(OUT) :: err
5943  TYPE(varying_string), INTENT(OUT) :: error
5944  !Local Variables
5945 
5946  enters("Petsc_TSGetSolution",err,error,*999)
5947 
5948  CALL tsgetsolution(ts%ts,currentsolution%vec,err)
5949  IF(err/=0) THEN
5950  IF(petschandleerror) THEN
5951  chkerrq(err)
5952  ENDIF
5953  CALL flagerror("PETSc error in TSGetSolution.",err,error,*999)
5954  ENDIF
5955 
5956  exits("Petsc_TSGetSolution")
5957  RETURN
5958 999 errorsexits("Petsc_TSGetSolution",err,error)
5959  RETURN 1
5960 
5961  END SUBROUTINE petsc_tsgetsolution
5962 
5963  !
5964  !================================================================================================================================
5965  !
5966 
5968  SUBROUTINE petsc_tsmonitorset(ts,mFunction,ctx,err,error,*)
5970  !Argument Variables
5971  TYPE(petsctstype), INTENT(INOUT) :: ts
5972  EXTERNAL :: mfunction
5973  TYPE(solver_type), POINTER :: ctx
5974  INTEGER(INTG), INTENT(OUT) :: err
5975  TYPE(varying_string), INTENT(OUT) :: error
5976  !Local Variables
5977 
5978  enters("Petsc_TSMonitorSet",err,error,*999)
5979 
5980  CALL tsmonitorset(ts%ts,mfunction,ctx,petsc_null_function,err)
5981  IF(err/=0) THEN
5982  IF(petschandleerror) THEN
5983  chkerrq(err)
5984  ENDIF
5985  CALL flagerror("PETSc error in TSMonitorSet.",err,error,*999)
5986  ENDIF
5987 
5988  exits("Petsc_TSMonitorSet")
5989  RETURN
5990 999 errorsexits("Petsc_TSMonitorSet",err,error)
5991  RETURN 1
5992 
5993  END SUBROUTINE petsc_tsmonitorset
5994 
5995  !
5996  !================================================================================================================================
5997  !
5998 
6000  SUBROUTINE petsc_tssetduration(ts,maxSteps,maxTime,err,error,*)
6002  TYPE(petsctstype), INTENT(INOUT) :: ts
6003  INTEGER(INTG), INTENT(IN) :: maxSteps
6004  REAL(DP), INTENT(IN) :: maxTime
6005  INTEGER(INTG), INTENT(OUT) :: err
6006  TYPE(varying_string), INTENT(OUT) :: error
6007  !Local Variables
6008 
6009  enters("Petsc_TSSetDuration",err,error,*999)
6010 
6011  CALL tssetduration(ts%ts,maxsteps,maxtime,err)
6012  IF(err/=0) THEN
6013  IF(petschandleerror) THEN
6014  chkerrq(err)
6015  ENDIF
6016  CALL flagerror("PETSc error in TSSetDuration.",err,error,*999)
6017  ENDIF
6018 
6019  exits("Petsc_TSSetDuration")
6020  RETURN
6021 999 errorsexits("Petsc_TSSetDuration",err,error)
6022  RETURN 1
6023 
6024  END SUBROUTINE petsc_tssetduration
6025 
6026  !
6027  !================================================================================================================================
6028  !
6029 
6031  SUBROUTINE petsc_tssetexactfinaltime(ts,exactFinalTime,err,error,*)
6033  TYPE(petsctstype), INTENT(INOUT) :: ts
6034  LOGICAL, INTENT(IN) :: exactFinalTime
6035  INTEGER(INTG), INTENT(OUT) :: err
6036  TYPE(varying_string), INTENT(OUT) :: error
6037  !Local Variables
6038 
6039  enters("Petsc_TSSetExactFinalTime",err,error,*999)
6040 
6041  IF(exactfinaltime) THEN
6042  CALL tssetexactfinaltime(ts%ts,petsc_true,err)
6043  ELSE
6044  CALL tssetexactfinaltime(ts%ts,petsc_false,err)
6045  ENDIF
6046 
6047  IF(err/=0) THEN
6048  IF(petschandleerror) THEN
6049  chkerrq(err)
6050  ENDIF
6051  CALL flagerror("PETSc error in TSSetExactFinalTime.",err,error,*999)
6052  ENDIF
6053 
6054  exits("Petsc_TSSetExactFinalTime")
6055  RETURN
6056 999 errorsexits("Petsc_TSSetExactFinalTime",err,error)
6057  RETURN 1
6058 
6059  END SUBROUTINE petsc_tssetexactfinaltime
6060 
6061  !
6062  !================================================================================================================================
6063  !
6064 
6066  SUBROUTINE petsc_tssetfromoptions(ts,err,error,*)
6068  TYPE(petsctstype), INTENT(INOUT) :: ts
6069  INTEGER(INTG), INTENT(OUT) :: err
6070  TYPE(varying_string), INTENT(OUT) :: error
6071  !Local Variables
6072 
6073  enters("Petsc_TSSetFromOptions",err,error,*999)
6074 
6075  CALL tssetfromoptions(ts%ts,err)
6076  IF(err/=0) THEN
6077  IF(petschandleerror) THEN
6078  chkerrq(err)
6079  ENDIF
6080  CALL flagerror("PETSc error in TSSetFromOptions.",err,error,*999)
6081  ENDIF
6082 
6083  exits("Petsc_TSSetFromOptions")
6084  RETURN
6085 999 errorsexits("Petsc_TSSetFromOptions",err,error)
6086  RETURN 1
6087 
6088  END SUBROUTINE petsc_tssetfromoptions
6089 
6090  !
6091  !================================================================================================================================
6092  !
6093 
6095  SUBROUTINE petsc_tssetinitialtimestep(ts,initialTime,timeStep,err,error,*)
6097  TYPE(petsctstype), INTENT(INOUT) :: ts
6098  REAL(DP), INTENT(IN) :: initialTime
6099  REAL(DP), INTENT(IN) :: timeStep
6100  INTEGER(INTG), INTENT(OUT) :: err
6101  TYPE(varying_string), INTENT(OUT) :: error
6102  !Local Variables
6103 
6104  enters("Petsc_TSSetInitialTimeStep",err,error,*999)
6105 
6106  CALL tssetinitialtimestep(ts%ts,initialtime,timestep,err)
6107  IF(err/=0) THEN
6108  IF(petschandleerror) THEN
6109  chkerrq(err)
6110  ENDIF
6111  CALL flagerror("PETSc error in TSSetInitialTimeStep.",err,error,*999)
6112  ENDIF
6113 
6114  exits("Petsc_TSSetInitialTimeStep")
6115  RETURN
6116 999 errorsexits("Petsc_TSSetInitialTimeStep",err,error)
6117  RETURN 1
6118 
6119  END SUBROUTINE petsc_tssetinitialtimestep
6120 
6121  !
6122  !================================================================================================================================
6123  !
6124 
6126  SUBROUTINE petsc_tssetproblemtype(ts,probType,err,error,*)
6128  TYPE(petsctstype), INTENT(INOUT) :: ts
6129  INTEGER(INTG), INTENT(IN) :: probType
6130  INTEGER(INTG), INTENT(OUT) :: err
6131  TYPE(varying_string), INTENT(OUT) :: error
6132  !Local Variables
6133 
6134  enters("Petsc_TSSetProblemType",err,error,*999)
6135 
6136  CALL tssetproblemtype(ts%ts,probtype,err)
6137  IF(err/=0) THEN
6138  IF(petschandleerror) THEN
6139  chkerrq(err)
6140  ENDIF
6141  CALL flagerror("PETSc error in TSSetProblemType.",err,error,*999)
6142  ENDIF
6143 
6144  exits("Petsc_TSSetProblemType")
6145  RETURN
6146 999 errorsexits("Petsc_TSSetProblemType",err,error)
6147  RETURN 1
6148 
6149  END SUBROUTINE petsc_tssetproblemtype
6150 
6151  !
6152  !================================================================================================================================
6153  !
6154 
6156  SUBROUTINE petsc_tssetrhsfunction(ts,rates,rhsFunction,ctx,err,error,*)
6158  TYPE(petsctstype), INTENT(INOUT) :: ts
6159  TYPE(petscvectype), INTENT(INOUT) :: rates
6160  EXTERNAL rhsfunction
6161  TYPE(cellmlpetsccontexttype), POINTER :: ctx
6162  INTEGER(INTG), INTENT(OUT) :: err
6163  TYPE(varying_string), INTENT(OUT) :: error
6164  !Local Variables
6165 
6166  enters("Petsc_TSSetRHSFunction",err,error,*999)
6167 
6168  CALL tssetrhsfunction(ts%ts,rates%vec,rhsfunction,ctx,err)
6169  IF(err/=0) THEN
6170  IF(petschandleerror) THEN
6171  chkerrq(err)
6172  ENDIF
6173  CALL flagerror("PETSc error in TSSetRHSFunction.",err,error,*999)
6174  ENDIF
6175 
6176  exits("Petsc_TSSetRHSFunction")
6177  RETURN
6178 999 errorsexits("Petsc_TSSetRHSFunction",err,error)
6179  RETURN 1
6180 
6181  END SUBROUTINE petsc_tssetrhsfunction
6182 
6183  !
6184  !================================================================================================================================
6185  !
6186 
6188  SUBROUTINE petsc_tssetsolution(ts,initialSolution,err,error,*)
6190  TYPE(petsctstype), INTENT(INOUT) :: ts
6191  TYPE(petscvectype), INTENT(IN) :: initialSolution
6192  INTEGER(INTG), INTENT(OUT) :: err
6193  TYPE(varying_string), INTENT(OUT) :: error
6194  !Local Variables
6195 
6196  enters("Petsc_TSSetSolution",err,error,*999)
6197 
6198  CALL tssetsolution(ts%ts,initialsolution%vec,err)
6199  IF(err/=0) THEN
6200  IF(petschandleerror) THEN
6201  chkerrq(err)
6202  ENDIF
6203  CALL flagerror("PETSc error in TSSetSolution.",err,error,*999)
6204  ENDIF
6205 
6206  exits("Petsc_TSSetSolution")
6207  RETURN
6208 999 errorsexits("Petsc_TSSetSolution",err,error)
6209  RETURN 1
6210 
6211  END SUBROUTINE petsc_tssetsolution
6212 
6213  !
6214  !================================================================================================================================
6215  !
6216 
6218  SUBROUTINE petsc_tssettimestep(ts,timeStep,err,error,*)
6220  TYPE(petsctstype), INTENT(INOUT) :: ts
6221  REAL(DP), INTENT(IN) :: timeStep
6222  INTEGER(INTG), INTENT(OUT) :: err
6223  TYPE(varying_string), INTENT(OUT) :: error
6224  !Local Variables
6225 
6226  enters("Petsc_TSSetTimeStep",err,error,*999)
6227 
6228  CALL tssettimestep(ts%ts,timestep,err)
6229  IF(err/=0) THEN
6230  IF(petschandleerror) THEN
6231  chkerrq(err)
6232  ENDIF
6233  CALL flagerror("PETSc error in TSSetTimeStep.",err,error,*999)
6234  ENDIF
6235 
6236  exits("Petsc_TSSetTimeStep")
6237  RETURN
6238 999 errorsexits("Petsc_TSSetTimeStep",err,error)
6239  RETURN 1
6240 
6241  END SUBROUTINE petsc_tssettimestep
6242 
6243  !
6244  !================================================================================================================================
6245  !
6246 
6248  SUBROUTINE petsc_tssettype(ts,method,err,error,*)
6250  TYPE(petsctstype), INTENT(INOUT) :: ts
6251  tstype, INTENT(IN) :: method
6252  INTEGER(INTG), INTENT(OUT) :: err
6253  TYPE(varying_string), INTENT(OUT) :: error
6254  !Local Variables
6255 
6256  enters("Petsc_TSSetType",err,error,*999)
6257 
6258  CALL tssettype(ts%ts,method,err)
6259  IF(err/=0) THEN
6260  IF(petschandleerror) THEN
6261  chkerrq(err)
6262  ENDIF
6263  CALL flagerror("PETSc error in TSSetType.",err,error,*999)
6264  ENDIF
6265 
6266  exits("Petsc_TSSetType")
6267  RETURN
6268 999 errorsexits("Petsc_TSSetType",err,error)
6269  RETURN 1
6270 
6271  END SUBROUTINE petsc_tssettype
6272 
6273  !
6274  !================================================================================================================================
6275  !
6276 
6278  SUBROUTINE petsc_tssolve(ts,x,finalTime,err,error,*)
6280  TYPE(petsctstype), INTENT(INOUT) :: ts
6281  TYPE(petscvectype), INTENT(INOUT) :: x
6282  REAL(DP), INTENT(OUT) :: finalTime
6283  INTEGER(INTG), INTENT(OUT) :: err
6284  TYPE(varying_string), INTENT(OUT) :: error
6285  !Local Variables
6286 
6287  enters("Petsc_TSSolve",err,error,*999)
6288 
6289  CALL tssolve(ts%ts,x%vec,finaltime,err)
6290  IF(err/=0) THEN
6291  IF(petschandleerror) THEN
6292  chkerrq(err)
6293  ENDIF
6294  CALL flagerror("PETSc error in TSSolve.",err,error,*999)
6295  ENDIF
6296 
6297  exits("Petsc_TSSolve")
6298  RETURN
6299 999 errorsexits("Petsc_TSSolve",err,error)
6300  RETURN 1
6301 
6302  END SUBROUTINE petsc_tssolve
6303 
6304  !
6305  !================================================================================================================================
6306  !
6307 
6309  SUBROUTINE petsc_tsstep(ts,steps,pTime,err,error,*)
6311  TYPE(petsctstype), INTENT(INOUT) :: ts
6312  INTEGER(INTG), INTENT(IN) :: steps
6313  REAL(DP), INTENT(IN) :: pTime
6314  INTEGER(INTG), INTENT(OUT) :: err
6315  TYPE(varying_string), INTENT(OUT) :: error
6316  !Local Variables
6317 
6318  enters("Petsc_TSStep",err,error,*999)
6319 
6320  CALL tsstep(ts%ts,steps,ptime,err)
6321  IF(err/=0) THEN
6322  IF(petschandleerror) THEN
6323  chkerrq(err)
6324  ENDIF
6325  CALL flagerror("PETSc error in TSStep.",err,error,*999)
6326  ENDIF
6327 
6328  exits("Petsc_TSStep")
6329  RETURN
6330 999 errorsexits("Petsc_TSStep",err,error)
6331  RETURN 1
6332 
6333  END SUBROUTINE petsc_tsstep
6334 
6335  !
6336  !================================================================================================================================
6337  !
6338 
6340  SUBROUTINE petsc_tssundialssettype(ts,sundialsType,err,error,*)
6342  TYPE(petsctstype), INTENT(INOUT) :: ts
6343  tssundialstype, INTENT(IN) :: sundialstype
6344  INTEGER(INTG), INTENT(OUT) :: err
6345  TYPE(varying_string), INTENT(OUT) :: error
6346  !Local Variables
6347 
6348  enters("Petsc_TSSundialsSetType",err,error,*999)
6349 
6350  CALL tssundialssettype(ts%ts,sundialstype,err)
6351  IF(err/=0) THEN
6352  IF(petschandleerror) THEN
6353  chkerrq(err)
6354  ENDIF
6355  CALL flagerror("PETSc error in TSSundialsSetType.",err,error,*999)
6356  ENDIF
6357 
6358  exits("Petsc_TSSundialsSetType")
6359  RETURN
6360 999 errorsexits("Petsc_TSSundialsSetType",err,error)
6361  RETURN 1
6362 
6363  END SUBROUTINE petsc_tssundialssettype
6364  !
6365  !================================================================================================================================
6366  !
6367 
6369  SUBROUTINE petsc_tssundialssettolerance(ts,absTol,relTol,err,error,*)
6371  TYPE(petsctstype), INTENT(INOUT) :: ts
6372  REAL(DP), INTENT(IN) :: absTol
6373  REAL(DP), INTENT(IN) :: relTol
6374  INTEGER(INTG), INTENT(OUT) :: err
6375  TYPE(varying_string), INTENT(OUT) :: error
6376  !Local Variables
6377 
6378  enters("Petsc_TSSundialsSetTolerance",err,error,*999)
6379 
6380  CALL tssundialssettolerance(ts%ts,abstol,reltol,err)
6381  IF(err/=0) THEN
6382  IF(petschandleerror) THEN
6383  chkerrq(err)
6384  ENDIF
6385  CALL flagerror("PETSc error in TSSundialsSetTolerance.",err,error,*999)
6386  ENDIF
6387 
6388  exits("Petsc_TSSundialsSetTolerance")
6389  RETURN
6390 999 errorsexits("Petsc_TSSundialsSetTolerance",err,error)
6391  RETURN 1
6392 
6393  END SUBROUTINE petsc_tssundialssettolerance
6394  !
6395  !================================================================================================================================
6396  !
6397 
6398  !Finalise the PETSc Vec structure and destroy the KSP
6399  SUBROUTINE petsc_vecfinalise(x,err,error,*)
6401  !Argument Variables
6402  TYPE(petscvectype), INTENT(INOUT) :: x
6403  INTEGER(INTG), INTENT(OUT) :: err
6404  TYPE(varying_string), INTENT(OUT) :: error
6405  !Local Variables
6406 
6407  enters("Petsc_VecFinalise",err,error,*999)
6408 
6409  IF(x%vec/=petsc_null_object) THEN
6410  CALL petsc_vecdestroy(x,err,error,*999)
6411  ENDIF
6412 
6413  exits("Petsc_VecFinalise")
6414  RETURN
6415 999 errorsexits("Petsc_VecFinalise",err,error)
6416  RETURN 1
6417 
6418  END SUBROUTINE petsc_vecfinalise
6419 
6420  !
6421  !================================================================================================================================
6422  !