5 REAL(KIND=8) :: rel_tol, abs_tol
6 CHARACTER(LEN=20) :: solver, precond
11 SUBROUTINE init_solver(my_par,my_ksp,matrix,communicator,solver,precond, opt_re_init)
14 LOGICAl,
INTENT(IN),
OPTIONAL :: opt_re_init
16 CHARACTER(*),
OPTIONAL ::
solver, precond
19 #include "petsc/finclude/petsc.h"
23 petscerrorcode :: ierr
24 mpi_comm :: communicator
26 IF (.NOT.present(opt_re_init))
THEN
32 IF (my_par%it_max.LE.0)
THEN
35 IF (my_par%rel_tol.LE.0.d0)
THEN
36 my_par%rel_tol = 1.d-8
38 IF (my_par%abs_tol.LE.0.d0)
THEN
39 my_par%abs_tol = 1.d-14
42 IF (.NOT.re_init) CALL kspcreate(communicator,my_ksp,ierr)
47 CALL kspsetoperators(my_ksp,matrix,matrix,ierr)
52 IF (
solver(deb:fin)==
'BCGS')
THEN
53 CALL kspsettype(my_ksp, kspbcgs, ierr)
54 ELSE IF (
solver(deb:fin)==
'GMRES')
THEN
55 CALL kspsettype(my_ksp, kspgmres, ierr)
56 ELSE IF (
solver(deb:fin)==
'FGMRES')
THEN
57 CALL kspsettype(my_ksp, kspfgmres, ierr)
58 ELSE IF (
solver(deb:fin)==
'PCR')
THEN
59 CALL kspsettype(my_ksp, kspcr, ierr)
60 ELSE IF (
solver(deb:fin)==
'CHEBYCHEV')
THEN
61 CALL kspsettype(my_ksp, kspchebyshev, ierr)
62 ELSE IF (
solver(deb:fin)==
'CG')
THEN
63 CALL kspsettype(my_ksp, kspcg, ierr)
65 CALL kspsettype(my_ksp, kspfgmres, ierr)
68 CALL kspsettype(my_ksp, kspfgmres, ierr)
70 CALL kspsettolerances(my_ksp, my_par%rel_tol, my_par%abs_tol, &
71 petsc_default_real, my_par%it_max, ierr)
72 CALL kspgetpc(my_ksp, prec, ierr)
73 IF (present(precond))
THEN
76 IF (precond(deb:fin)==
'JACOBI')
THEN
77 call pcsettype(prec, pcbjacobi, ierr)
78 ELSE IF (precond(deb:fin)==
'HYPRE')
THEN
79 CALL pcsettype(prec, pchypre, ierr)
80 ELSE IF (precond(deb:fin)==
'SSOR')
THEN
81 CALL pcsettype(prec, pcsor, ierr)
82 ELSE IF (precond(deb:fin)==
'MUMPS')
THEN
83 CALL pcsettype(prec, pclu, ierr)
84 CALL kspsettype(my_ksp, ksppreonly, ierr)
85 CALL pcfactorsetmatsolverpackage(prec, matsolvermumps, ierr)
87 CALL pcsettype(prec, pchypre, ierr)
90 CALL pcsettype(prec, pchypre, ierr)
92 CALL kspsetfromoptions(my_ksp, ierr)
95 SUBROUTINE solver(my_ksp,b,x,reinit,verbose)
97 LOGICAL,
OPTIONAL :: reinit,
verbose
99 #include "petsc/finclude/petsc.h"
101 petscerrorcode :: ierr
103 kspconvergedreason :: reason
104 IF (.NOT.present(reinit)) reinit=.true.
107 IF (reinit) CALL veczeroentries(x,ierr)
108 CALL kspsolve(my_ksp,b,x,ierr)
110 CALL kspgetiterationnumber(my_ksp, its, ierr)
111 CALL kspgetconvergedreason(my_ksp, reason, ierr)
114 WRITE(*,*)
"KSP_CONVERGED_RTOL, Nb of iterations", its
116 WRITE(*,*)
"KSP_CONVERGED_ATOL, Nb of iterations", its
118 WRITE(*,*)
"Converged after one single iteration of the preconditioner is applied"
120 WRITE(*,*)
"Converge for strange reason:", reason
122 WRITE(*,*)
"KSP_DIVERGED_NULL"
124 WRITE(*,*)
"Not converged after it_max", its
126 WRITE(*,*)
"Not converged: explosion"
128 WRITE(*,*)
"Not converged for strange reasons", reason
130 WRITE(*,*)
"Not converged: Indefinite preconditioner"
132 WRITE(*,*)
"Not converged: NAN"
134 WRITE(*,*)
"Not converged: Indefinite matrix"
136 WRITE(*,*)
"Something strange happened", reason
146 LOGICAL,
OPTIONAL :: clean
147 REAL(KIND=8),
DIMENSION(:),
POINTER :: aa
148 INTEGER :: nnzm1, dom_np
149 LOGICAL :: test_clean
153 #include "petsc/finclude/petsc.h"
154 mpi_comm :: communicator
156 petscerrorcode :: ierr
158 dom_np =
SIZE(la%ia)-1
159 nnzm1=la%ia(dom_np)-la%ia(0)-1
160 ALLOCATE(aa(0:nnzm1))
171 CALL matcreatempiaijwitharrays(communicator,dom_np,dom_np,petsc_decide, &
172 petsc_decide, la%ia, la%ja, aa, matrix, ierr)
175 IF (present(clean))
THEN
181 IF (
ASSOCIATED(la%ia))
DEALLOCATE(la%ia)
182 IF (
ASSOCIATED(la%ja))
DEALLOCATE(la%ja)
190 INTEGER,
DIMENSION(2) :: i_loc
191 INTEGER,
DIMENSION(:),
POINTER :: ia, ja
192 REAL(KIND=8),
DIMENSION(:),
POINTER :: aa
193 INTEGER :: nnzm1, dom_np, p, i, n
194 #include "petsc/finclude/petsc.h"
195 mpi_comm :: communicator
197 petscerrorcode :: ierr
199 dom_np = i_loc(2) - i_loc(1) + 1
200 nnzm1 = aij%ia(i_loc(2)+1)-aij%ia(i_loc(1))-1
201 ALLOCATE(ia(0:dom_np),ja(0:nnzm1))
205 ia(i) = aij%ia(n+1)-aij%ia(i_loc(1))
206 DO p=aij%ia(n), aij%ia(n+1)-1
207 ja(p-aij%ia(i_loc(1)))= aij%ja(p)-1
211 ALLOCATE(aa(0:nnzm1))
213 CALL matcreatempiaijwitharrays(communicator,dom_np,dom_np,petsc_decide, &
214 petsc_decide, ia, ja, aa, matrix, ierr)
223 INTEGER,
DIMENSION(2) :: i_loc
225 INTEGER,
DIMENSION(:),
POINTER :: ia, ja
226 REAL(KIND=8),
DIMENSION(:),
POINTER :: aa
227 INTEGER :: nnzm1, dom_np, p, i, n, ib, k
228 #include "petsc/finclude/petsc.h"
229 mpi_comm :: communicator
231 petscerrorcode :: ierr
233 dom_np = i_loc(2) - i_loc(1) + 1
234 nnzm1 = n_b*(aij%ia(i_loc(2)+1)-aij%ia(i_loc(1))-1)
235 ALLOCATE(ia(0:n_b*dom_np),ja(0:nnzm1))
239 ib = i + (k-1)*dom_np
241 ia(i) = n_b*(aij%ia(n+1)-aij%ia(i_loc(1)))
242 DO p=aij%ia(n), aij%ia(n+1)-1
243 ja(p-aij%ia(i_loc(1)))= aij%ja(p)-1
248 ALLOCATE(aa(0:nnzm1))
250 CALL matcreatempiaijwitharrays(communicator,dom_np,dom_np,petsc_decide, &
251 petsc_decide, ia, ja, aa, matrix, ierr)
subroutine init_solver(my_par, my_ksp, matrix, communicator, solver, precond, opt_re_init)
integer function, public start_of_string(string)
subroutine solver(my_ksp, b, x, reinit, verbose)
integer function, public last_of_string(string)
subroutine create_local_petsc_block_matrix(communicator, n_b, aij, i_loc, matrix)
subroutine create_local_petsc_matrix_a_detruire(communicator, aij, i_loc, matrix)
subroutine create_local_petsc_matrix(communicator, LA, matrix, clean)