solver.F90 coverage: 90.91 %func 43.40 %block
1) module Solver_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) #include "petsc/finclude/petscvec.h"
12) #include "petsc/finclude/petscvec.h90"
13) #include "petsc/finclude/petscmat.h"
14) #include "petsc/finclude/petscmat.h90"
15) #include "petsc/finclude/petscksp.h"
16) #include "petsc/finclude/petscpc.h"
17) #include "petsc/finclude/petscsnes.h"
18) #include "petsc/finclude/petscts.h"
19) ! If the PETSc release is 3.3 or lower, then include petscpcmg.h.
20) ! If using an older version of petsc-dev and petscpcmg.h is required,
21) ! it can be used by having the makefile turn on HAVE_PETSCPCMG_H.
22) #if (((PETSC_VERSION_RELEASE) && ((PETSC_VERSION_MAJOR<3) || ((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR<=3)))) || (HAVE_PETSCPCMG_H))
23) #include "petsc/finclude/petscpcmg.h"
24) #endif
25)
26) !#include "petsc/finclude/petscpcmg.h"
27)
28) type, public :: solver_type
29) PetscInt :: itype ! type: flow or transport
30) PetscReal :: linear_atol ! absolute tolerance
31) PetscReal :: linear_rtol ! relative tolerance
32) PetscReal :: linear_dtol ! divergence tolerance
33) PetscInt :: linear_max_iterations ! maximum number of iterations
34) PetscReal :: linear_zero_pivot_tol ! zero pivot tolerance for LU
35)
36) PetscReal :: newton_atol ! absolute tolerance
37) PetscReal :: newton_rtol ! relative tolerance
38) PetscReal :: newton_stol ! relative tolerance (relative to previous iteration)
39) PetscReal :: newton_dtol ! divergence tolerance
40) PetscReal :: newton_inf_res_tol ! infinity tolerance for residual
41) PetscReal :: newton_inf_upd_tol ! infinity tolerance for update
42) PetscReal :: newton_inf_rel_update_tol ! infinity norm on relative update (c(i)-c(i-1))/c(i-1)
43) PetscReal :: newton_inf_scaled_res_tol ! infinity norm on scale residual (r(i)/accum(i))
44) PetscReal :: newton_inf_res_tol_sec ! infinity tolerance for secondary continuum residual
45) PetscInt :: newton_max_iterations ! maximum number of iterations
46) PetscInt :: newton_min_iterations ! minimum number of iterations
47) PetscInt :: newton_maxf ! maximum number of function evaluations
48) PetscReal :: max_norm ! maximum norm for divergence
49) PetscBool :: use_galerkin_mg ! If true, precondition linear systems with
50) ! Galerkin-type geometric multigrid.
51) PetscInt :: galerkin_mg_levels ! Number of discretization levels for
52) ! the Galerkin MG (includes finest level).
53) PetscInt :: galerkin_mg_levels_x
54) PetscInt :: galerkin_mg_levels_y
55) PetscInt :: galerkin_mg_levels_z
56)
57) ! Jacobian matrix
58) Mat :: J ! Jacobian
59) Mat :: Jpre ! Jacobian to be used in preconditioner
60) MatType :: J_mat_type
61) MatType :: Jpre_mat_type
62)
63) MatFDColoring :: matfdcoloring
64) ! Coloring used for computing the Jacobian via finite differences.
65)
66) Mat, pointer :: interpolation(:)
67) ! Hierarchy of interpolation operators for Galerkin multigrid.
68)
69) ! PETSc nonlinear solver context
70) SNES :: snes
71) KSPType :: ksp_type
72) PCType :: pc_type
73) KSP :: ksp
74) PC :: pc
75) TS :: ts
76)
77) PetscBool :: inexact_newton
78)
79) PetscBool :: print_convergence
80) PetscBool :: print_detailed_convergence
81) PetscBool :: print_linear_iterations
82) PetscBool :: check_infinity_norm
83) PetscBool :: print_ekg
84)
85) end type solver_type
86)
87) public :: SolverCreate, &
88) SolverDestroy, &
89) SolverReadLinear, &
90) SolverReadNewton, &
91) SolverCreateSNES, &
92) SolverSetSNESOptions, &
93) SolverCreateTS, &
94) SolverPrintNewtonInfo, &
95) SolverPrintLinearInfo, &
96) SolverCheckCommandLine, &
97) SolverLinearPrintFailedReason
98)
99) contains
100)
101) ! ************************************************************************** !
102)
103) function SolverCreate()
104) !
105) ! Allocates and initializes a new (empty) Solver object
106) ! Note that this does not create the PETSc solver contexts associated
107) ! with the Solver. These contexts are created via a subsequent call to
108) ! SolverCreateSNES().
109) !
110) ! Author: Glenn Hammond
111) ! Date: 10/25/07
112) !
113)
114) implicit none
115)
116) type(solver_type), pointer :: SolverCreate
117)
118) type(solver_type), pointer :: solver
119)
120) allocate(solver)
121)
122) ! initialize to default values
123) solver%itype = NULL_CLASS
124) solver%linear_atol = PETSC_DEFAULT_REAL
125) solver%linear_rtol = PETSC_DEFAULT_REAL
126) solver%linear_dtol = PETSC_DEFAULT_REAL
127) solver%linear_max_iterations = PETSC_DEFAULT_INTEGER
128) solver%linear_zero_pivot_tol = UNINITIALIZED_DOUBLE
129)
130) solver%newton_atol = PETSC_DEFAULT_REAL
131) solver%newton_rtol = PETSC_DEFAULT_REAL
132) solver%newton_stol = PETSC_DEFAULT_REAL
133) solver%newton_dtol = PETSC_DEFAULT_REAL
134) solver%max_norm = 1.d20 ! set to a large value
135) solver%newton_inf_res_tol = UNINITIALIZED_DOUBLE
136) solver%newton_inf_upd_tol = UNINITIALIZED_DOUBLE
137) solver%newton_inf_rel_update_tol = UNINITIALIZED_DOUBLE
138) solver%newton_inf_scaled_res_tol = UNINITIALIZED_DOUBLE
139) solver%newton_inf_res_tol_sec = 1.d-10
140) solver%newton_max_iterations = PETSC_DEFAULT_INTEGER
141) solver%newton_min_iterations = 1
142) solver%newton_maxf = PETSC_DEFAULT_INTEGER
143)
144) solver%use_galerkin_mg = PETSC_FALSE
145) solver%galerkin_mg_levels = 1
146) solver%galerkin_mg_levels_x = 1
147) solver%galerkin_mg_levels_y = 1
148) solver%galerkin_mg_levels_z = 1
149)
150) solver%J = 0
151) solver%Jpre = 0
152) solver%J_mat_type = MATBAIJ
153) solver%Jpre_mat_type = ''
154) ! solver%interpolation = 0
155) nullify(solver%interpolation)
156) solver%matfdcoloring = 0
157) solver%snes = 0
158) solver%ksp_type = KSPBCGS
159) solver%pc_type = ""
160) solver%ksp = 0
161) solver%pc = 0
162) solver%ts = 0
163)
164) solver%inexact_newton = PETSC_FALSE
165)
166) solver%print_convergence = PETSC_TRUE
167) solver%print_detailed_convergence = PETSC_FALSE
168) solver%print_linear_iterations = PETSC_FALSE
169) solver%check_infinity_norm = PETSC_TRUE
170) solver%print_ekg = PETSC_FALSE
171)
172) SolverCreate => solver
173)
174) end function SolverCreate
175)
176) ! ************************************************************************** !
177)
178) subroutine SolverCreateSNES(solver,comm)
179) !
180) ! Create PETSc SNES object
181) !
182) ! Author: Glenn Hammond
183) ! Date: 02/12/08
184) !
185)
186) implicit none
187)
188) type(solver_type) :: solver
189)
190) PetscMPIInt :: comm
191) PetscErrorCode :: ierr
192)
193) call SNESCreate(comm,solver%snes,ierr);CHKERRQ(ierr)
194) call SNESSetFromOptions(solver%snes,ierr);CHKERRQ(ierr)
195)
196) ! grab handles for ksp and pc
197) call SNESGetKSP(solver%snes,solver%ksp,ierr);CHKERRQ(ierr)
198) call KSPGetPC(solver%ksp,solver%pc,ierr);CHKERRQ(ierr)
199)
200) end subroutine SolverCreateSNES
201)
202) ! ************************************************************************** !
203)
204) subroutine SolverSetSNESOptions(solver)
205) !
206) ! Sets options for SNES
207) !
208) ! Author: Glenn Hammond
209) ! Date: 02/12/08
210) !
211)
212) implicit none
213)
214) type(solver_type) :: solver
215)
216) SNESLineSearch :: linesearch
217) PetscErrorCode :: ierr
218) PetscInt :: i
219)
220) ! if ksp_type or pc_type specified in input file, set them here
221) if (len_trim(solver%ksp_type) > 1) then
222) call KSPSetType(solver%ksp,solver%ksp_type,ierr);CHKERRQ(ierr)
223) endif
224) if (len_trim(solver%pc_type) > 1) then
225) call PCSetType(solver%pc,solver%pc_type,ierr);CHKERRQ(ierr)
226) endif
227)
228) call KSPSetTolerances(solver%ksp,solver%linear_rtol,solver%linear_atol, &
229) solver%linear_dtol,solver%linear_max_iterations, &
230) ierr);CHKERRQ(ierr)
231) ! as of PETSc 3.7, we need to turn on error reporting due to zero pivots
232) ! as PETSc no longer reports zero pivots for very small concentrations
233) !geh: this get overwritten by ksp->errorifnotconverted
234) call KSPSetErrorIfNotConverged(solver%ksp,PETSC_TRUE,ierr); CHKERRQ(ierr)
235)
236) ! allow override from command line
237) call KSPSetFromOptions(solver%ksp,ierr);CHKERRQ(ierr)
238) call PCSetFromOptions(solver%pc,ierr);CHKERRQ(ierr)
239)
240) ! get the ksp_type and pc_type incase of command line override.
241) call KSPGetType(solver%ksp,solver%ksp_type,ierr);CHKERRQ(ierr)
242) call PCGetType(solver%pc,solver%pc_type,ierr);CHKERRQ(ierr)
243)
244) if (Initialized(solver%linear_zero_pivot_tol)) then
245) call PCFactorSetZeroPivot(solver%pc,solver%linear_zero_pivot_tol, &
246) ierr);CHKERRQ(ierr)
247) endif
248)
249) ! Set the tolerances for the Newton solver.
250) call SNESSetTolerances(solver%snes, solver%newton_atol, solver%newton_rtol, &
251) solver%newton_stol,solver%newton_max_iterations, &
252) solver%newton_maxf,ierr);CHKERRQ(ierr)
253)
254) ! set inexact newton, currently applies default settings
255) if (solver%inexact_newton) then
256) call SNESKSPSetUseEW(solver%snes,PETSC_TRUE,ierr);CHKERRQ(ierr)
257) endif
258)
259) ! call SNESLineSearchSet(solver%snes,SNESLineSearchNo,PETSC_NULL)
260)
261) ! Setup for n-level Galerkin multigrid.
262) if (solver%use_galerkin_mg) then
263) call PCSetType(solver%pc, PCMG,ierr);CHKERRQ(ierr)
264) call PCMGSetLevels(solver%pc, solver%galerkin_mg_levels, &
265) PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
266) do i=1,solver%galerkin_mg_levels-1
267) call PCMGSetInterpolation(solver%pc, i, solver%interpolation(i), &
268) ierr);CHKERRQ(ierr)
269) call PCMGSetGalerkin(solver%pc,ierr);CHKERRQ(ierr)
270) enddo
271) endif
272)
273) ! allow override from command line; for some reason must come before
274) ! LineSearchParams, or they crash
275) call SNESSetFromOptions(solver%snes,ierr);CHKERRQ(ierr)
276)
277) call SNESGetLineSearch(solver%snes, linesearch, ierr);CHKERRQ(ierr)
278) call SNESLineSearchSetTolerances(linesearch, solver%newton_stol, &
279) PETSC_DEFAULT_REAL,PETSC_DEFAULT_REAL, &
280) PETSC_DEFAULT_REAL,PETSC_DEFAULT_REAL, &
281) PETSC_DEFAULT_INTEGER, ierr);CHKERRQ(ierr)
282)
283) call SNESGetTolerances(solver%snes,solver%newton_atol,solver%newton_rtol, &
284) solver%newton_stol,solver%newton_max_iterations, &
285) solver%newton_maxf,ierr);CHKERRQ(ierr)
286)
287) call KSPGetTolerances(solver%ksp,solver%linear_rtol,solver%linear_atol, &
288) solver%linear_dtol,solver%linear_max_iterations, &
289) ierr);CHKERRQ(ierr)
290)
291) end subroutine SolverSetSNESOptions
292)
293) ! ************************************************************************** !
294)
295) subroutine SolverCreateTS(solver,comm)
296) !
297) ! This routine creates PETSc TS object.
298) !
299) ! Author: Gautam Bisht, LBL
300) ! Date: 01/18/13
301) !
302)
303) implicit none
304)
305) type(solver_type) :: solver
306)
307) PetscMPIInt :: comm
308) PetscErrorCode :: ierr
309)
310) call TSCreate(comm,solver%ts,ierr);CHKERRQ(ierr)
311) call TSSetFromOptions(solver%ts,ierr);CHKERRQ(ierr)
312)
313) end subroutine SolverCreateTS
314)
315) ! ************************************************************************** !
316)
317) subroutine SolverReadLinear(solver,input,option)
318) !
319) ! Reads parameters associated with linear solver
320) !
321) ! Author: Glenn Hammond
322) ! Date: 12/21/07
323) !
324)
325) use Input_Aux_module
326) use String_module
327) use Option_module
328)
329) implicit none
330)
331) type(solver_type) :: solver
332) type(input_type), pointer :: input
333) type(option_type) :: option
334) PetscErrorCode :: ierr
335)
336) character(len=MAXWORDLENGTH) :: keyword, word, word2, prefix
337) character(len=MAXSTRINGLENGTH) :: string
338)
339) select case(solver%itype)
340) case(FLOW_CLASS)
341) prefix = '-flow_'
342) case(TRANSPORT_CLASS)
343) prefix = '-tran_'
344) end select
345)
346) input%ierr = 0
347) do
348)
349) call InputReadPflotranString(input,option)
350)
351) if (InputCheckExit(input,option)) exit
352)
353) call InputReadWord(input,option,keyword,PETSC_TRUE)
354) call InputErrorMsg(input,option,'keyword','LINEAR SOLVER')
355) call StringToUpper(keyword)
356)
357) select case(trim(keyword))
358)
359) case('SOLVER_TYPE','SOLVER','KRYLOV_TYPE','KRYLOV','KSP','KSP_TYPE')
360) call InputReadWord(input,option,word,PETSC_TRUE)
361) call InputErrorMsg(input,option,'ksp_type','LINEAR SOLVER')
362) call StringToUpper(word)
363) select case(trim(word))
364) case('NONE','PREONLY')
365) solver%ksp_type = KSPPREONLY
366) case('GMRES')
367) solver%ksp_type = KSPGMRES
368) case('FGMRES')
369) solver%ksp_type = KSPFGMRES
370) case('BCGS','BICGSTAB','BI-CGSTAB')
371) solver%ksp_type = KSPBCGS
372) case('IBCGS','IBICGSTAB','IBI-CGSTAB')
373) solver%ksp_type = KSPIBCGS
374) case('RICHARDSON')
375) solver%ksp_type = KSPRICHARDSON
376) case('CG')
377) solver%ksp_type = KSPCG
378) case('DIRECT')
379) solver%ksp_type = KSPPREONLY
380) solver%pc_type = PCLU
381) case('ITERATIVE','KRYLOV')
382) solver%ksp_type = KSPBCGS
383) solver%pc_type = PCBJACOBI
384) case default
385) option%io_buffer = 'Krylov solver type: ' // trim(word) // &
386) ' unknown.'
387) call printErrMsg(option)
388) end select
389)
390) case('PRECONDITIONER_TYPE','PRECONDITIONER','PC','PC_TYPE')
391) call InputReadWord(input,option,word,PETSC_TRUE)
392) call InputErrorMsg(input,option,'pc_type','LINEAR SOLVER')
393) call StringToUpper(word)
394) select case(trim(word))
395) case('NONE','PCNONE')
396) solver%pc_type = PCNONE
397) case('ILU','PCILU')
398) solver%pc_type = PCILU
399) case('LU','PCLU')
400) solver%pc_type = PCLU
401) case('BJACOBI','BLOCK_JACOBI')
402) solver%pc_type = PCBJACOBI
403) case('JACOBI')
404) solver%pc_type = PCJACOBI
405) case('ASM','ADDITIVE_SCHWARZ')
406) solver%pc_type = PCASM
407) case('HYPRE')
408) solver%pc_type = PCHYPRE
409) case('SHELL')
410) solver%pc_type = PCSHELL
411) case default
412) option%io_buffer = 'Preconditioner type: ' // trim(word) // &
413) ' unknown.'
414) call printErrMsg(option)
415) end select
416)
417) case('HYPRE_OPTIONS')
418) do
419) call InputReadPflotranString(input,option)
420) if (InputCheckExit(input,option)) exit
421) call InputReadWord(input,option,keyword,PETSC_TRUE)
422) call InputErrorMsg(input,option,'keyword', &
423) 'LINEAR SOLVER, HYPRE options')
424) call StringToUpper(keyword)
425) select case(trim(keyword))
426) case('TYPE')
427) call InputReadWord(input,option,word,PETSC_TRUE)
428) call InputErrorMsg(input,option,'type', &
429) 'LINEAR SOLVER, HYPRE options')
430) call StringToLower(word)
431) select case(trim(word))
432) case('pilut','parasails','boomeramg','euclid')
433) string = trim(prefix) // 'pc_hypre_type'
434) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
435) trim(string),trim(word), &
436) ierr);CHKERRQ(ierr)
437) case default
438) option%io_buffer = 'HYPRE preconditioner type: ' // &
439) trim(word) // ' unknown.'
440) call printErrMsg(option)
441) end select
442) case('BOOMERAMG_CYCLE_TYPE')
443) call InputReadWord(input,option,word,PETSC_TRUE)
444) call InputErrorMsg(input,option,'BoomerAMG cycle type', &
445) 'LINEAR SOLVER, HYPRE options')
446) call StringToLower(word)
447) string = trim(prefix) // 'pc_hypre_boomeramg_cycle_type'
448) select case(trim(word))
449) case('V')
450) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
451) trim(string),'1', &
452) ierr);CHKERRQ(ierr)
453) case('W')
454) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
455) trim(string),'2', &
456) ierr);CHKERRQ(ierr)
457) case default
458) option%io_buffer = 'HYPRE BoomerAMG cycle type: ' &
459) // trim(word) // ' unknown.'
460) call printErrMsg(option)
461) end select
462) case('BOOMERAMG_MAX_LEVELS')
463) call InputReadWord(input,option,word,PETSC_TRUE)
464) call InputErrorMsg(input,option,'BoomerAMG maximum levels', &
465) 'LINEAR SOLVER, HYPRE options')
466) string = trim(prefix) // 'pc_hypre_boomeramg_max_levels'
467) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
468) trim(string),trim(word), &
469) ierr);CHKERRQ(ierr)
470) case('BOOMERAMG_MAX_ITER')
471) call InputReadWord(input,option,word,PETSC_TRUE)
472) call InputErrorMsg(input,option,'BoomerAMG maximum iterations', &
473) 'LINEAR SOLVER, HYPRE options')
474) string = trim(prefix) // 'pc_hypre_boomeramg_max_iter'
475) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
476) trim(string),trim(word), &
477) ierr);CHKERRQ(ierr)
478) case('BOOMERAMG_TOL')
479) call InputReadWord(input,option,word,PETSC_TRUE)
480) call InputErrorMsg(input,option, &
481) 'BoomerAMG convergence tolerance', &
482) 'LINEAR SOLVER, HYPRE options')
483) string = trim(prefix) // 'pc_hypre_boomeramg_tol'
484) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
485) trim(string),trim(word), &
486) ierr);CHKERRQ(ierr)
487) case('BOOMERAMG_TRUNCFACTOR')
488) call InputReadWord(input,option,word,PETSC_TRUE)
489) call InputErrorMsg(input,option, &
490) 'BoomerAMG interpolation truncation factor', &
491) 'LINEAR SOLVER, HYPRE options')
492) string = trim(prefix) // 'pc_hypre_boomeramg_truncfactor'
493) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
494) trim(string),trim(word), &
495) ierr);CHKERRQ(ierr)
496) case('BOOMERAMG_AGG_NL')
497) call InputReadWord(input,option,word,PETSC_TRUE)
498) call InputErrorMsg(input,option, &
499) 'BoomerAMG # levels aggressive coarsening', &
500) 'LINEAR SOLVER, HYPRE options')
501) string = trim(prefix) // 'pc_hypre_boomeramg_agg_nl'
502) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
503) trim(string),trim(word), &
504) ierr);CHKERRQ(ierr)
505) case('BOOMERAMG_AGG_NUM_PATHS')
506) call InputReadWord(input,option,word,PETSC_TRUE)
507) call InputErrorMsg(input,option, &
508) 'BoomerAMG # paths for aggressive coarsening', &
509) 'LINEAR SOLVER, HYPRE options')
510) string = trim(prefix) // 'pc_hypre_boomeramg_agg_num_paths'
511) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
512) trim(string),trim(word), &
513) ierr);CHKERRQ(ierr)
514) case('BOOMERAMG_STRONG_THRESHOLD')
515) call InputReadWord(input,option,word,PETSC_TRUE)
516) call InputErrorMsg(input,option, &
517) 'BoomerAMG threshold for strong connectivity', &
518) 'LINEAR SOLVER, HYPRE options')
519) string = trim(prefix) // 'pc_hypre_boomeramg_strong_threshold'
520) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
521) trim(string),trim(word), &
522) ierr);CHKERRQ(ierr)
523) case('BOOMERAMG_GRID_SWEEPS_ALL')
524) call InputReadWord(input,option,word,PETSC_TRUE)
525) call InputErrorMsg(input,option, &
526) 'BoomerAMG number of grid sweeps up and down cycles', &
527) 'LINEAR SOLVER, HYPRE options')
528) string = trim(prefix) // 'pc_hypre_boomeramg_grid_sweeps_all'
529) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
530) trim(string),trim(word), &
531) ierr);CHKERRQ(ierr)
532) case('BOOMERAMG_GRID_SWEEPS_DOWN')
533) call InputReadWord(input,option,word,PETSC_TRUE)
534) call InputErrorMsg(input,option, &
535) 'BoomerAMG number of grid sweeps down cycles', &
536) 'LINEAR SOLVER, HYPRE options')
537) string = trim(prefix) // 'pc_hypre_boomeramg_grid_sweeps_down'
538) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
539) trim(string),trim(word), &
540) ierr);CHKERRQ(ierr)
541) case('BOOMERAMG_GRID_SWEEPS_UP')
542) call InputReadWord(input,option,word,PETSC_TRUE)
543) call InputErrorMsg(input,option, &
544) 'BoomerAMG number of grid sweeps up cycles', &
545) 'LINEAR SOLVER, HYPRE options')
546) string = trim(prefix) // 'pc_hypre_boomeramg_grid_sweeps_up'
547) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
548) trim(string),trim(word), &
549) ierr);CHKERRQ(ierr)
550) case('BOOMERAMG_GRID_SWEEPS_COARSE')
551) call InputReadWord(input,option,word,PETSC_TRUE)
552) call InputErrorMsg(input,option, &
553) 'BoomerAMG number of grid sweeps for coarse level', &
554) 'LINEAR SOLVER, HYPRE options')
555) string = trim(prefix) // 'pc_hypre_boomeramg_grid_sweeps_coarse'
556) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
557) trim(string),trim(word), &
558) ierr);CHKERRQ(ierr)
559) case('BOOMERAMG_RELAX_TYPE_ALL')
560) call InputReadWord(input,option,word,PETSC_TRUE)
561) call InputErrorMsg(input,option, &
562) 'BoomerAMG relaxation type for up and down cycles', &
563) 'LINEAR SOLVER, HYPRE options')
564) string = trim(prefix) // 'pc_hypre_boomeramg_relax_type_all'
565) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
566) trim(string),trim(word), &
567) ierr);CHKERRQ(ierr)
568) case('BOOMERAMG_RELAX_TYPE_DOWN')
569) call InputReadWord(input,option,word,PETSC_TRUE)
570) call InputErrorMsg(input,option, &
571) 'BoomerAMG relaxation type for down cycles', &
572) 'LINEAR SOLVER, HYPRE options')
573) string = trim(prefix) // 'pc_hypre_boomeramg_relax_type_down'
574) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
575) trim(string),trim(word), &
576) ierr);CHKERRQ(ierr)
577) case('BOOMERAMG_RELAX_TYPE_UP')
578) call InputReadWord(input,option,word,PETSC_TRUE)
579) call InputErrorMsg(input,option, &
580) 'BoomerAMG relaxation type for up cycles', &
581) 'LINEAR SOLVER, HYPRE options')
582) string = trim(prefix) // 'pc_hypre_boomeramg_relax_type_up'
583) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
584) trim(string),trim(word), &
585) ierr);CHKERRQ(ierr)
586) case('BOOMERAMG_RELAX_TYPE_COARSE')
587) call InputReadWord(input,option,word,PETSC_TRUE)
588) call InputErrorMsg(input,option, &
589) 'BoomerAMG relaxation type for coarse grids', &
590) 'LINEAR SOLVER, HYPRE options')
591) string = trim(prefix) // 'pc_hypre_boomeramg_relax_type_coarse'
592) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
593) trim(string),trim(word), &
594) ierr);CHKERRQ(ierr)
595) case('BOOMERAMG_RELAX_WEIGHT_ALL')
596) call InputReadWord(input,option,word,PETSC_TRUE)
597) call InputErrorMsg(input,option, &
598) 'BoomerAMG relaxation weight for all levels', &
599) 'LINEAR SOLVER, HYPRE options')
600) string = trim(prefix) // 'pc_hypre_boomeramg_relax_weight_all'
601) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
602) trim(string),trim(word), &
603) ierr);CHKERRQ(ierr)
604) case('BOOMERAMG_RELAX_WEIGHT_LEVEL')
605) call InputReadWord(input,option,word,PETSC_TRUE)
606) call InputReadWord(input,option,word2,PETSC_TRUE)
607) call InputErrorMsg(input,option, &
608) 'BoomerAMG relaxation weight for a level', &
609) 'LINEAR SOLVER, HYPRE options')
610) word = trim(word) // ' ' // trim(word2)
611) string = trim(prefix) // 'pc_hypre_boomeramg_relax_weight_level'
612) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
613) trim(string),trim(word), &
614) ierr);CHKERRQ(ierr)
615) case('BOOMERAMG_OUTER_RELAX_WEIGHT_ALL')
616) call InputReadWord(input,option,word,PETSC_TRUE)
617) call InputErrorMsg(input,option, &
618) 'BoomerAMG outer relaxation weight for all levels', &
619) 'LINEAR SOLVER, HYPRE options')
620) string = trim(prefix) // &
621) 'pc_hypre_boomeramg_outer_relax_weight_all'
622) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
623) trim(string),trim(word), &
624) ierr);CHKERRQ(ierr)
625) case('BOOMERAMG_OUTER_RELAX_WEIGHT_LEVEL')
626) call InputReadWord(input,option,word,PETSC_TRUE)
627) call InputReadWord(input,option,word2,PETSC_TRUE)
628) call InputErrorMsg(input,option, &
629) 'BoomerAMG outer relaxation weight for a level', &
630) 'LINEAR SOLVER, HYPRE options')
631) word = trim(word) // ' ' // trim(word2)
632) string = trim(prefix) // &
633) 'pc_hypre_boomeramg_outer_relax_weight_level'
634) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
635) trim(string),trim(word), &
636) ierr);CHKERRQ(ierr)
637) case('BOOMERAMG_NO_CF')
638) string = trim(prefix) // 'pc_hypre_boomeramg_no_CF'
639) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
640) trim(string),'',ierr);CHKERRQ(ierr)
641) case('BOOMERAMG_MEASURE_TYPE')
642) call InputReadWord(input,option,word,PETSC_TRUE)
643) call InputErrorMsg(input,option,'BoomerAMG measure type', &
644) 'LINEAR SOLVER, HYPRE options')
645) string = trim(prefix) // 'pc_hypre_boomeramg_measure_type'
646) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
647) trim(string),trim(word), &
648) ierr);CHKERRQ(ierr)
649) case('BOOMERAMG_COARSEN_TYPE')
650) call InputReadWord(input,option,word,PETSC_TRUE)
651) call InputErrorMsg(input,option,'BoomerAMG coarsen type', &
652) 'LINEAR SOLVER, HYPRE options')
653) string = trim(prefix) // 'pc_hypre_boomeramg_coarsen_type'
654) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
655) trim(string),trim(word), &
656) ierr);CHKERRQ(ierr)
657) case('BOOMERAMG_INTERPOLATION_TYPE','BOOMERAMG_INTERP_TYPE')
658) call InputReadWord(input,option,word,PETSC_TRUE)
659) call InputErrorMsg(input,option,'BoomerAMG interpolation type', &
660) 'LINEAR SOLVER, HYPRE options')
661) string = trim(prefix) // 'pc_hypre_boomeramg_interp_type'
662) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
663) trim(string),trim(word), &
664) ierr);CHKERRQ(ierr)
665) case('BOOMERAMG_NODAL_COARSEN')
666) call InputReadWord(input,option,word,PETSC_TRUE)
667) call InputErrorMsg(input,option, &
668) 'BoomerAMG set nodal coarsening', &
669) 'LINEAR SOLVER, HYPRE options')
670) string = trim(prefix) // 'pc_hypre_boomeramg_nodal_coarsen'
671) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
672) trim(string),'',ierr);CHKERRQ(ierr)
673) case('BOOMERAMG_NODAL_RELAXATION')
674) call InputReadWord(input,option,word,PETSC_TRUE)
675) call InputErrorMsg(input,option, &
676) 'BoomerAMG nodal relaxation via Schwarz', &
677) 'LINEAR SOLVER, HYPRE options')
678) string = trim(prefix) // 'pc_hypre_boomeramg_nodal_relaxation'
679) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
680) trim(string),'',ierr);CHKERRQ(ierr)
681) case default
682) option%io_buffer = 'HYPRE option: ' // trim(keyword) // &
683) ' unknown.'
684) call printErrMsg(option)
685) end select
686) enddo
687)
688) case('ATOL')
689) call InputReadDouble(input,option,solver%linear_atol)
690) call InputErrorMsg(input,option,'linear_atol','LINEAR_SOLVER')
691)
692) case('RTOL')
693) call InputReadDouble(input,option,solver%linear_rtol)
694) call InputErrorMsg(input,option,'linear_rtol','LINEAR_SOLVER')
695)
696) case('DTOL')
697) call InputReadDouble(input,option,solver%linear_dtol)
698) call InputErrorMsg(input,option,'linear_dtol','LINEAR_SOLVER')
699)
700) case('MAXIT')
701) call InputReadInt(input,option,solver%linear_max_iterations)
702) call InputErrorMsg(input,option,'linear_max_iterations','LINEAR_SOLVER')
703)
704) case('ZERO_PIVOT_TOL','LU_ZERO_PIVOT_TOL')
705) call InputReadDouble(input,option,solver%linear_zero_pivot_tol)
706) call InputErrorMsg(input,option,'linear_zero_pivot_tol', &
707) 'LINEAR_SOLVER')
708)
709) case('MUMPS')
710) string = trim(prefix) // 'pc_factor_mat_solver_package'
711) word = 'mumps'
712) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
713) trim(string),trim(word),ierr);CHKERRQ(ierr)
714)
715) case default
716) call InputKeywordUnrecognized(keyword,'LINEAR_SOLVER',option)
717) end select
718)
719) enddo
720)
721) end subroutine SolverReadLinear
722)
723) ! ************************************************************************** !
724)
725) subroutine SolverReadNewton(solver,input,option)
726) !
727) ! Reads parameters associated with linear solver
728) !
729) ! Author: Glenn Hammond
730) ! Date: 12/21/07
731) !
732)
733) use Input_Aux_module
734) use String_module
735) use Option_module
736)
737) implicit none
738)
739) type(solver_type) :: solver
740) type(input_type), pointer :: input
741) type(option_type) :: option
742)
743) character(len=MAXWORDLENGTH) :: keyword, word, word2
744)
745) input%ierr = 0
746) do
747)
748) call InputReadPflotranString(input,option)
749)
750) if (InputCheckExit(input,option)) exit
751)
752) call InputReadWord(input,option,keyword,PETSC_TRUE)
753) call InputErrorMsg(input,option,'keyword','NEWTON SOLVER')
754) call StringToUpper(keyword)
755)
756) select case(trim(keyword))
757)
758) case ('INEXACT_NEWTON')
759) solver%inexact_newton = PETSC_TRUE
760)
761) case ('NO_PRINT_CONVERGENCE')
762) solver%print_convergence = PETSC_FALSE
763)
764) case ('NO_INF_NORM','NO_INFINITY_NORM')
765) solver%check_infinity_norm = PETSC_FALSE
766)
767) case('MAXIMUM_NEWTON_ITERATIONS')
768) call InputReadInt(input,option,solver%newton_max_iterations)
769) call InputErrorMsg(input,option,'maximum newton iterations', &
770) 'NEWTON_SOLVER')
771)
772) case('MINIMUM_NEWTON_ITERATIONS')
773) call InputReadInt(input,option,solver%newton_min_iterations)
774) call InputErrorMsg(input,option,'minimum newton iterations', &
775) 'NEWTON_SOLVER')
776)
777) case ('PRINT_DETAILED_CONVERGENCE')
778) solver%print_detailed_convergence = PETSC_TRUE
779)
780) case ('PRINT_LINEAR_ITERATIONS')
781) solver%print_linear_iterations = PETSC_TRUE
782)
783) case('ATOL')
784) call InputReadDouble(input,option,solver%newton_atol)
785) call InputErrorMsg(input,option,'newton_atol','NEWTON_SOLVER')
786)
787) case('RTOL')
788) call InputReadDouble(input,option,solver%newton_rtol)
789) call InputErrorMsg(input,option,'newton_rtol','NEWTON_SOLVER')
790)
791) case('STOL')
792) call InputReadDouble(input,option,solver%newton_stol)
793) call InputErrorMsg(input,option,'newton_stol','NEWTON_SOLVER')
794)
795) case('DTOL')
796) call InputReadDouble(input,option,solver%newton_dtol)
797) call InputErrorMsg(input,option,'newton_dtol','NEWTON_SOLVER')
798)
799) case('MAX_NORM')
800) call InputReadDouble(input,option,solver%max_norm)
801) call InputErrorMsg(input,option,'max_norm','NEWTON_SOLVER')
802)
803) case('ITOL', 'INF_TOL', 'ITOL_RES', 'INF_TOL_RES')
804) call InputReadDouble(input,option,solver%newton_inf_res_tol)
805) call InputErrorMsg(input,option,'newton_inf_res_tol','NEWTON_SOLVER')
806)
807) case('ITOL_UPDATE', 'INF_TOL_UPDATE')
808) call InputReadDouble(input,option,solver%newton_inf_upd_tol)
809) call InputErrorMsg(input,option,'newton_inf_upd_tol','NEWTON_SOLVER')
810)
811) case('ITOL_SCALED_RESIDUAL')
812) option%io_buffer = 'Flow NEWTON_SOLVER ITOL_SCALED_RESIDUAL is ' // &
813) 'now specific to each process model and must be defined in ' // &
814) 'the SIMULATION/PROCESS_MODELS/SUBSURFACE_FLOW/OPTIONS block.'
815) call printErrMsg(option)
816)
817) case('ITOL_RELATIVE_UPDATE')
818) option%io_buffer = 'Flow NEWTON_SOLVER ITOL_RELATIVE_UPDATE is ' // &
819) 'now specific to each process model and must be defined in ' // &
820) 'the SIMULATION/PROCESS_MODELS/SUBSURFACE_FLOW/OPTIONS block.'
821) call printErrMsg(option)
822)
823) case('ITOL_SEC','ITOL_RES_SEC','INF_TOL_SEC')
824) if (.not.option%use_mc) then
825) option%io_buffer = 'NEWTON ITOL_SEC not supported without ' // &
826) 'MULTIPLE_CONTINUUM keyword.'
827) call printErrMsg(option)
828) endif
829) if (.not.solver%itype == TRANSPORT_CLASS) then
830) option%io_buffer = 'NEWTON ITOL_SEC supported in ' // &
831) 'TRANSPORT only.'
832) call printErrMsg(option)
833) endif
834) call InputReadDouble(input,option,solver%newton_inf_res_tol_sec)
835) call InputErrorMsg(input,option,'newton_inf_res_tol_sec', &
836) 'NEWTON_SOLVER')
837)
838) case('MAXIT')
839) call InputReadInt(input,option,solver%newton_max_iterations)
840) call InputErrorMsg(input,option,'maximum newton iterations', &
841) 'NEWTON_SOLVER')
842)
843) case('MAXF')
844) call InputReadInt(input,option,solver%newton_maxf)
845) call InputErrorMsg(input,option,'newton_maxf','NEWTON_SOLVER')
846)
847) case('MATRIX_TYPE')
848) call InputReadWord(input,option,word,PETSC_TRUE)
849) call InputErrorMsg(input,option,'mat_type','NEWTON SOLVER')
850) call StringToUpper(word)
851) select case(trim(word))
852) case('BAIJ')
853) solver%J_mat_type = MATBAIJ
854) case('AIJ')
855) ! solver%J_mat_type = MATBAIJ
856) solver%J_mat_type = MATAIJ
857) case('MFFD','MATRIX_FREE')
858) solver%J_mat_type = MATMFFD
859) case('HYPRESTRUCT')
860) solver%J_mat_type = MATHYPRESTRUCT
861) case default
862) option%io_buffer = 'Matrix type: ' // trim(word) // ' unknown.'
863) call printErrMsg(option)
864) end select
865)
866) case('PRECONDITIONER_MATRIX_TYPE')
867) call InputReadWord(input,option,word,PETSC_TRUE)
868) call InputErrorMsg(input,option,'mat_type','NEWTON SOLVER')
869) call StringToUpper(word)
870) select case(trim(word))
871) case('BAIJ')
872) solver%Jpre_mat_type = MATBAIJ
873) case('AIJ')
874) ! solver%Jpre_mat_type = MATBAIJ
875) solver%Jpre_mat_type = MATAIJ
876) case('MFFD','MATRIX_FREE')
877) solver%Jpre_mat_type = MATMFFD
878) case('HYPRESTRUCT')
879) solver%Jpre_mat_type = MATHYPRESTRUCT
880) case('SHELL')
881) solver%Jpre_mat_type = MATSHELL
882) case default
883) option%io_buffer = 'Preconditioner Matrix type: ' // trim(word) // ' unknown.'
884) call printErrMsg(option)
885) end select
886)
887) case default
888) call InputKeywordUnrecognized(keyword,'NEWTON_SOLVER',option)
889) end select
890)
891) enddo
892)
893) end subroutine SolverReadNewton
894)
895) ! ************************************************************************** !
896)
897) subroutine SolverPrintLinearInfo(solver,header,option)
898) !
899) ! Prints information about linear solver
900) !
901) ! Author: Glenn Hammond
902) ! Date: 02/23/08
903) !
904)
905) use Option_module
906)
907) implicit none
908)
909) type(solver_type) :: solver
910) character(len=*) :: header
911) type(option_type) :: option
912)
913) PetscInt :: fid
914)
915) #if !defined(PETSC_HAVE_MUMPS)
916) if (option%mycommsize > 1) then
917) if (solver%ksp_type == KSPPREONLY .and. solver%pc_type == PCLU) then
918) option%io_buffer = 'Direct solver (KSPPREONLY + PCLU) not ' // &
919) ' supported when running in parallel. Switch to SOLVER ITERATIVE.'
920) call printErrMsg(option)
921) endif
922) endif
923) #endif
924)
925) if (OptionPrintToScreen(option)) then
926) write(*,*)
927) write(*,'(a)') trim(header) // ' Linear Solver'
928) write(*,'(" solver: ",a)') trim(solver%ksp_type)
929) write(*,'(" precond: ",a)') trim(solver%pc_type)
930) write(*,'(" atol:",1pe12.4)') solver%linear_atol
931) write(*,'(" rtol:",1pe12.4)') solver%linear_rtol
932) write(*,'(" dtol:",1pe12.4)') solver%linear_dtol
933) write(*,'(" max iter:",i7)') solver%linear_max_iterations
934) if (Initialized(solver%linear_zero_pivot_tol)) then
935) write(*,'("pivot tol:",1pe12.4)') solver%linear_zero_pivot_tol
936) endif
937) endif
938)
939) if (OptionPrintToFile(option)) then
940) fid = option%fid_out
941) write(fid,*)
942) write(fid,'(a)') trim(header) // ' Linear Solver'
943) write(fid,'(" solver: ",a)') trim(solver%ksp_type)
944) write(fid,'(" precond: ",a)') trim(solver%pc_type)
945) write(fid,'(" atol:",1pe12.4)') solver%linear_atol
946) write(fid,'(" rtol:",1pe12.4)') solver%linear_rtol
947) write(fid,'(" dtol:",1pe12.4)') solver%linear_dtol
948) write(fid,'(" max iter:",i7)') solver%linear_max_iterations
949) if (Initialized(solver%linear_zero_pivot_tol)) then
950) write(fid,'("pivot tol:",1pe12.4)') solver%linear_zero_pivot_tol
951) endif
952) endif
953)
954) end subroutine SolverPrintLinearInfo
955)
956) ! ************************************************************************** !
957)
958) subroutine SolverPrintNewtonInfo(solver,header,option)
959) !
960) ! Prints information about Newton solver
961) !
962) ! Author: Glenn Hammond
963) ! Date: 02/23/08
964) !
965) use Option_module
966)
967) implicit none
968)
969) type(solver_type) :: solver
970) character(len=*) :: header
971) type(option_type) :: option
972) PetscInt :: fid
973)
974) if (OptionPrintToScreen(option)) then
975) write(*,*)
976) write(*,'(a)') trim(header) // ' Newton Solver'
977) write(*,'(" atol:",1pe12.4)') solver%newton_atol
978) write(*,'(" rtol:",1pe12.4)') solver%newton_rtol
979) write(*,'(" stol:",1pe12.4)') solver%newton_stol
980) write(*,'(" dtol:",1pe12.4)') solver%newton_dtol
981) write(*,'(" maxnorm:",1pe12.4)') solver%max_norm
982) write(*,'(" inftolres:",1pe12.4)') solver%newton_inf_res_tol
983) write(*,'(" inftolupd:",1pe12.4)') solver%newton_inf_upd_tol
984) write(*,'("inftolrelupd:",1pe12.4)') solver%newton_inf_rel_update_tol
985) write(*,'("inftolsclres:",1pe12.4)') solver%newton_inf_scaled_res_tol
986) write(*,'(" max iter:",i6)') solver%newton_max_iterations
987) write(*,'(" min iter:",i6)') solver%newton_min_iterations
988) write(*,'(" maxf:",i6)') solver%newton_maxf
989) write(*,*)
990) if (len_trim(solver%J_mat_type) > 2) then
991) write(*,'("matrix type:",a20)') solver%J_mat_type
992) endif
993) if (len_trim(solver%Jpre_mat_type) > 2) then
994) write(*,'("precond. matrix type:",a20)') solver%Jpre_mat_type
995) endif
996) if (solver%inexact_newton) then
997) write(*,'("inexact newton: on")')
998) else
999) write(*,'("inexact newton: off")')
1000) endif
1001)
1002) if (solver%print_convergence) then
1003) write(*,'("print convergence: on")')
1004) else
1005) write(*,'("print convergence: off")')
1006) endif
1007)
1008) if (solver%print_detailed_convergence) then
1009) write(*,'("print detailed convergence: on")')
1010) else
1011) write(*,'("print detailed convergence: off")')
1012) endif
1013)
1014) if (solver%check_infinity_norm) then
1015) write(*,'("check infinity norm: on")')
1016) else
1017) write(*,'("check infinity norm: off")')
1018) endif
1019) endif
1020)
1021) if (OptionPrintToFile(option)) then
1022) fid = option%fid_out
1023) write(fid,*)
1024) write(fid,'(a)') trim(header) // ' Newton Solver'
1025) write(fid,'(" atol:",1pe12.4)') solver%newton_atol
1026) write(fid,'(" rtol:",1pe12.4)') solver%newton_rtol
1027) write(fid,'(" stol:",1pe12.4)') solver%newton_stol
1028) write(fid,'(" dtol:",1pe12.4)') solver%newton_dtol
1029) write(fid,'(" maxnorm:",1pe12.4)') solver%max_norm
1030) write(fid,'(" inftolres:",1pe12.4)') solver%newton_inf_res_tol
1031) write(fid,'(" inftolupd:",1pe12.4)') solver%newton_inf_upd_tol
1032) write(fid,'("inftolrelupd:",1pe12.4)') solver%newton_inf_rel_update_tol
1033) write(fid,'("inftolsclres:",1pe12.4)') solver%newton_inf_scaled_res_tol
1034) write(fid,'(" max iter:",i6)') solver%newton_max_iterations
1035) write(fid,'(" min iter:",i6)') solver%newton_min_iterations
1036) write(fid,'(" maxf:",i6)') solver%newton_maxf
1037) write(fid,*)
1038) if (len_trim(solver%J_mat_type) > 2) then
1039) write(fid,'("matrix type:",a20)') solver%J_mat_type
1040) endif
1041) if (len_trim(solver%Jpre_mat_type) > 2) then
1042) write(fid,'("precond. matrix type:",a20)') solver%Jpre_mat_type
1043) endif
1044) if (solver%inexact_newton) then
1045) write(fid,'("inexact newton: on")')
1046) else
1047) write(fid,'("inexact newton: off")')
1048) endif
1049)
1050) if (solver%print_convergence) then
1051) write(fid,'("print convergence: on")')
1052) else
1053) write(fid,'("print convergence: off")')
1054) endif
1055)
1056) if (solver%print_detailed_convergence) then
1057) write(fid,'("print detailed convergence: on")')
1058) else
1059) write(fid,'("print detailed convergence: off")')
1060) endif
1061)
1062) if (solver%check_infinity_norm) then
1063) write(fid,'("check infinity norm: on")')
1064) else
1065) write(fid,'("check infinity norm: off")')
1066) endif
1067) endif
1068)
1069) end subroutine SolverPrintNewtonInfo
1070)
1071) ! ************************************************************************** !
1072)
1073) subroutine SolverCheckCommandLine(solver)
1074) !
1075) ! Parses the command line for various solver
1076) ! options.
1077) ! Note: In order to use the PETSc OptionsPrefix associated with
1078) ! solver%snes in parsing the options, the call to SolverCheckCommandLine()
1079) ! should come after the SNESSetOptionsPrefix(solver%snes,...) call.
1080) !
1081) ! Author: Richard Tran Mills
1082) ! Date: 05/09/2008
1083) !
1084)
1085) implicit none
1086)
1087) type(solver_type) :: solver
1088)
1089) PetscErrorCode :: ierr
1090) character(len=MAXSTRINGLENGTH) :: prefix
1091) character(len=MAXSTRINGLENGTH) :: mat_type
1092) PetscBool :: is_present
1093)
1094) if (solver%snes /= 0) then
1095) call SNESGetOptionsPrefix(solver%snes, prefix, ierr);CHKERRQ(ierr)
1096) else
1097) prefix = PETSC_NULL_CHARACTER
1098) endif
1099)
1100) ! Parse the options to determine if the matrix type has been specified.
1101) call PetscOptionsGetString(PETSC_NULL_OBJECT,prefix, '-mat_type', mat_type, &
1102) is_present,ierr);CHKERRQ(ierr)
1103) if (is_present) solver%J_mat_type = trim(mat_type)
1104)
1105) call PetscOptionsGetString(PETSC_NULL_OBJECT,prefix, '-pre_mat_type', &
1106) mat_type, is_present,ierr);CHKERRQ(ierr)
1107) if (is_present) solver%Jpre_mat_type = trim(mat_type)
1108)
1109) ! Parse the options for the Galerkin multigrid solver.
1110) ! Users can specify the number of levels of coarsening via the
1111) ! 'galerkin_mg N' option, which will set the number of levels in the
1112) ! x, y, and z directions all to N. For semi-coarsening, however,
1113) ! it is possible to set the number of levels in each direction
1114) ! individually via options such as '-galerkin_mg_x N', which would
1115) ! override the number of levels in the x direction set by '-galerkin_mg'.
1116) call PetscOptionsGetInt(PETSC_NULL_OBJECT,prefix, '-galerkin_mg', &
1117) solver%galerkin_mg_levels, solver%use_galerkin_mg, &
1118) ierr);CHKERRQ(ierr)
1119) if (solver%use_galerkin_mg) then
1120) solver%galerkin_mg_levels_x = solver%galerkin_mg_levels
1121) solver%galerkin_mg_levels_y = solver%galerkin_mg_levels
1122) solver%galerkin_mg_levels_z = solver%galerkin_mg_levels
1123) endif
1124)
1125) call PetscOptionsGetInt(PETSC_NULL_OBJECT,prefix, '-galerkin_mg_x', &
1126) solver%galerkin_mg_levels_x, is_present, &
1127) ierr);CHKERRQ(ierr)
1128) if (is_present) solver%use_galerkin_mg = PETSC_TRUE
1129) call PetscOptionsGetInt(PETSC_NULL_OBJECT,prefix, '-galerkin_mg_y', &
1130) solver%galerkin_mg_levels_y, is_present, &
1131) ierr);CHKERRQ(ierr)
1132) if (is_present) solver%use_galerkin_mg = PETSC_TRUE
1133) call PetscOptionsGetInt(PETSC_NULL_OBJECT,prefix, '-galerkin_mg_z', &
1134) solver%galerkin_mg_levels_z, is_present, &
1135) ierr);CHKERRQ(ierr)
1136) if (is_present) solver%use_galerkin_mg = PETSC_TRUE
1137)
1138) if (solver%use_galerkin_mg) then
1139) solver%J_mat_type = MATAIJ
1140) ! Must use AIJ above, as BAIJ is not supported for Galerkin MG solver.
1141) solver%galerkin_mg_levels = max(solver%galerkin_mg_levels_x, &
1142) solver%galerkin_mg_levels_y, &
1143) solver%galerkin_mg_levels_z)
1144) endif
1145)
1146)
1147) end subroutine SolverCheckCommandLine
1148)
1149) ! ************************************************************************** !
1150)
1151) subroutine SolverLinearPrintFailedReason(solver,option)
1152) !
1153) ! Prints the reason for the solver failing
1154) !
1155) ! Author: Glenn Hammond
1156) ! Date: 03/02/16
1157) !
1158) use Option_module
1159)
1160) implicit none
1161)
1162) type(solver_type) :: solver
1163) type(option_type) :: option
1164)
1165) KSPConvergedReason :: ksp_reason
1166) PetscErrorCode :: ierr
1167)
1168) call KSPGetConvergedReason(solver%ksp,ksp_reason,ierr);CHKERRQ(ierr)
1169) select case(ksp_reason)
1170) case(KSP_DIVERGED_ITS)
1171) option%io_buffer = ' -> KSPReason: Diverged due to iterations'
1172) case(KSP_DIVERGED_DTOL)
1173) option%io_buffer = ' -> KSPReason: Diverged due to dtol'
1174) case(KSP_DIVERGED_BREAKDOWN)
1175) option%io_buffer = ' -> KSPReason: Diverged due to breakdown'
1176) case(KSP_DIVERGED_BREAKDOWN_BICG)
1177) option%io_buffer = ' -> KSPReason: Diverged due to breakdown bicg'
1178) case(KSP_DIVERGED_NONSYMMETRIC)
1179) option%io_buffer = ' -> KSPReason: Diverged due to nonsymmetric'
1180) case(KSP_DIVERGED_INDEFINITE_PC)
1181) option%io_buffer = ' -> KSPReason: Diverged due to indefinite PC'
1182) case(KSP_DIVERGED_NANORINF)
1183) option%io_buffer = ' -> KSPReason: Diverged due to NaN or Inf PC'
1184) case(KSP_DIVERGED_INDEFINITE_MAT)
1185) option%io_buffer = ' -> KSPReason: Diverged due to indefinite matix'
1186) !geh: this value is defined in the PETSc master, but not maint.
1187) ! case(KSP_DIVERGED_PCSETUP_FAILED)
1188) case(-11)
1189) option%io_buffer = ' -> KSPReason: Diverged due to PC setup failed'
1190) case default
1191) write(option%io_buffer,'('' -> KSPReason: Unknown: '',i2)') &
1192) ksp_reason
1193) end select
1194) call printMsg(option)
1195)
1196) end subroutine SolverLinearPrintFailedReason
1197)
1198) ! ************************************************************************** !
1199)
1200) subroutine SolverDestroy(solver)
1201) !
1202) ! Deallocates a solver
1203) !
1204) ! Author: Glenn Hammond
1205) ! Date: 11/01/07
1206) !
1207)
1208) implicit none
1209)
1210) type(solver_type), pointer :: solver
1211)
1212) PetscErrorCode :: ierr
1213) PetscInt :: i
1214)
1215) if (.not.associated(solver)) return
1216)
1217) if (solver%Jpre == solver%J) then
1218) solver%Jpre = 0
1219) else if (solver%Jpre /= 0) then
1220) call MatDestroy(solver%Jpre,ierr);CHKERRQ(ierr)
1221) endif
1222) if (solver%J /= 0) then
1223) call MatDestroy(solver%J,ierr);CHKERRQ(ierr)
1224) endif
1225) if (associated(solver%interpolation)) then
1226) do i=1,solver%galerkin_mg_levels-1
1227) call MatDestroy(solver%interpolation(i),ierr);CHKERRQ(ierr)
1228) enddo
1229) deallocate(solver%interpolation)
1230) endif
1231) if (solver%matfdcoloring /= 0) then
1232) call MatFDColoringDestroy(solver%matfdcoloring,ierr);CHKERRQ(ierr)
1233) endif
1234)
1235) if (solver%snes /= 0) then
1236) call SNESDestroy(solver%snes,ierr);CHKERRQ(ierr)
1237) endif
1238) if (solver%ts /= 0) then
1239) call TSDestroy(solver%ts,ierr);CHKERRQ(ierr)
1240) endif
1241)
1242) solver%ksp = 0
1243) solver%pc = 0
1244)
1245) deallocate(solver)
1246) nullify(solver)
1247)
1248) end subroutine SolverDestroy
1249)
1250) end module Solver_module