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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody