OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
linear_solver_mod Module Reference

Data Types

type  t_linear_solver
type  t_cg_solver

Functions/Subroutines

subroutine error ()
integer function get_global_dim (this)
subroutine init_solver (this, mat_dim)
subroutine set_matrix (this, mat)
subroutine set_rhs (this, nrhs, rhs)
subroutine solve (this, sol, dim)
subroutine terminate (this)
subroutine init_solver_cg (this, mat_dim)
subroutine set_matrix_cg (this, mat)
subroutine set_rhs_cg (this, nrhs, rhs)
subroutine solve_cg (this, sol, dim)
subroutine terminate_cg (this)

Function/Subroutine Documentation

◆ error()

subroutine linear_solver_mod::error

Definition at line 118 of file linear_solver_mod.F.

119 print*, "ERROR"

◆ get_global_dim()

integer function linear_solver_mod::get_global_dim ( class (t_linear_solver), intent(in) this)

Definition at line 131 of file linear_solver_mod.F.

132C-----------------------------------------------
133C I m p l i c i t T y p e s
134C-----------------------------------------------
135 USE spmd_comm_world_mod, ONLY : spmd_comm_world
136#include "implicit_f.inc"
137 class(t_linear_solver), INTENT(IN) :: this
138 INTEGER :: GET_GLOBAL_DIM
139 get_global_dim = this%GLOBAL_DIMENSION

◆ init_solver()

subroutine linear_solver_mod::init_solver ( class (t_linear_solver), intent(inout) this,
integer, intent(in) mat_dim )

Definition at line 149 of file linear_solver_mod.F.

150C-----------------------------------------------
151C I m p l i c i t T y p e s
152C-----------------------------------------------
153 USE spmd_comm_world_mod, ONLY : spmd_comm_world
154#include "implicit_f.inc"
155 class(t_linear_solver), INTENT(INOUT) :: this
156 INTEGER, INTENT(IN) :: MAT_DIM
157 this%GLOBAL_DIMENSION = mat_dim
158 SELECT TYPE(this)
159#ifdef MUMPS5
160 TYPE IS (t_mumps_solver)
161 CALL this%INIT_SOLVER_MUMPS(mat_dim)
162#endif
163 TYPE IS (t_cg_solver)
164 CALL this%INIT_SOLVER_CG(mat_dim)
165 CLASS DEFAULT
166 CALL this%ERROR()
167 END SELECT

◆ init_solver_cg()

subroutine linear_solver_mod::init_solver_cg ( class (t_cg_solver), intent(inout) this,
integer, intent(in) mat_dim )

Definition at line 501 of file linear_solver_mod.F.

502C-----------------------------------------------
503C I m p l i c i t T y p e s
504C-----------------------------------------------
505 USE spmd_comm_world_mod, ONLY : spmd_comm_world
506#include "implicit_f.inc"
507 class(t_cg_solver), INTENT(INOUT) :: this
508 INTEGER, INTENT(IN) :: MAT_DIM
509
510 CALL this%SOL_VEC%CREATE(mat_dim)
511 CALL this%R%CREATE(mat_dim)
512 CALL this%RNEW%CREATE(mat_dim)
513 CALL this%TEMP%CREATE(mat_dim)
514 CALL this%P%CREATE(mat_dim)
515 ALLOCATE(this%DIAG(mat_dim))
516

◆ set_matrix()

subroutine linear_solver_mod::set_matrix ( class (t_linear_solver), intent(inout) this,
type(t_cfs_matrix), intent(inout) mat )

Definition at line 178 of file linear_solver_mod.F.

179C-----------------------------------------------
180C M o d u l e s
181C-----------------------------------------------
182 USE matrix_mod
183C-----------------------------------------------
184C I m p l i c i t T y p e s
185C-----------------------------------------------
186 USE spmd_comm_world_mod, ONLY : spmd_comm_world
187#include "implicit_f.inc"
188 class(t_linear_solver), INTENT(INOUT) :: this
189 TYPE(T_CFS_MATRIX), INTENT(INOUT) :: MAT
190 SELECT TYPE(this)
191#ifdef MUMPS5
192 TYPE IS (t_mumps_solver)
193 CALL this%SET_MATRIX_MUMPS(mat)
194#endif
195 TYPE IS (t_cg_solver)
196 CALL this%SET_MATRIX_CG(mat)
197 CLASS DEFAULT
198 CALL this%ERROR()
199 END SELECT
matrix_mod
Definition matrix_mod.F:34

◆ set_matrix_cg()

subroutine linear_solver_mod::set_matrix_cg ( class (t_cg_solver), intent(inout) this,
type(t_cfs_matrix), intent(inout), target mat )

Definition at line 527 of file linear_solver_mod.F.

528C-----------------------------------------------
529C M o d u l e s
530C-----------------------------------------------
531 USE matrix_mod
532C-----------------------------------------------
533C I m p l i c i t T y p e s
534C-----------------------------------------------
535 USE spmd_comm_world_mod, ONLY : spmd_comm_world
536#include "implicit_f.inc"
537 class(t_cg_solver), INTENT(INOUT) :: this
538 TYPE(T_CFS_MATRIX), INTENT(INOUT), TARGET :: MAT
539
540 this%MAT => mat
541

◆ set_rhs()

subroutine linear_solver_mod::set_rhs ( class (t_linear_solver), intent(inout) this,
integer, intent(in) nrhs,
type(t_vector), intent(inout) rhs )

Definition at line 210 of file linear_solver_mod.F.

211C-----------------------------------------------
212C M o d u l e s
213C-----------------------------------------------
214 USE vector_mod
215C-----------------------------------------------
216C I m p l i c i t T y p e s
217C-----------------------------------------------
218 USE spmd_comm_world_mod, ONLY : spmd_comm_world
219#include "implicit_f.inc"
220 class(t_linear_solver), INTENT(INOUT) :: this
221 INTEGER, INTENT(IN) :: NRHS
222 TYPE(T_VECTOR), INTENT(INOUT) :: RHS
223 SELECT TYPE(this)
224#ifdef MUMPS5
225 TYPE IS (t_mumps_solver)
226 CALL this%SET_RHS_MUMPS(nrhs, rhs)
227#endif
228 TYPE IS (t_cg_solver)
229 CALL this%SET_RHS_CG(nrhs, rhs)
230 CLASS DEFAULT
231 CALL this%ERROR()
232 END SELECT
vector_mod
Definition vector_mod.F:37

◆ set_rhs_cg()

subroutine linear_solver_mod::set_rhs_cg ( class (t_cg_solver), intent(inout) this,
integer, intent(in) nrhs,
type(t_vector), intent(inout), target rhs )

Definition at line 552 of file linear_solver_mod.F.

553C-----------------------------------------------
554C M o d u l e s
555C-----------------------------------------------
556 USE vector_mod
557C-----------------------------------------------
558C I m p l i c i t T y p e s
559C-----------------------------------------------
560 USE spmd_comm_world_mod, ONLY : spmd_comm_world
561#include "implicit_f.inc"
562 class(t_cg_solver), INTENT(INOUT) :: this
563 INTEGER, INTENT(IN) :: NRHS
564 TYPE(T_VECTOR), INTENT(INOUT), TARGET :: RHS
565
566 this%RHS => rhs
567 this%NRHS = nrhs
568
569

◆ solve()

subroutine linear_solver_mod::solve ( class (t_linear_solver), intent(inout) this,
double precision, dimension(dim), intent(out) sol,
integer, intent(in) dim )

Definition at line 242 of file linear_solver_mod.F.

243C-----------------------------------------------
244C I m p l i c i t T y p e s
245C-----------------------------------------------
246 USE spmd_comm_world_mod, ONLY : spmd_comm_world
247#include "implicit_f.inc"
248 class(t_linear_solver), INTENT(INOUT) :: this
249 INTEGER, INTENT(IN) :: DIM
250 DOUBLE PRECISION, DIMENSION(DIM), INTENT(OUT) :: SOL
251 SELECT TYPE(this)
252#ifdef MUMPS5
253 TYPE IS (t_mumps_solver)
254 CALL this%SOLVE_MUMPS(sol, dim)
255#endif
256 TYPE IS (t_cg_solver)
257 CALL this%SOLVE_CG(sol, dim)
258 CLASS DEFAULT
259 CALL this%ERROR()
260 END SELECT

◆ solve_cg()

subroutine linear_solver_mod::solve_cg ( class (t_cg_solver), intent(inout) this,
double precision, dimension(dim), intent(out), target sol,
integer, intent(in) dim )

Definition at line 582 of file linear_solver_mod.F.

583 USE vector_mod
584C-----------------------------------------------
585C I m p l i c i t T y p e s
586C-----------------------------------------------
587 USE spmd_comm_world_mod, ONLY : spmd_comm_world
588#include "implicit_f.inc"
589#include "com01_c.inc"
590#include "task_c.inc"
591C-----------------------------------------------
592C M e s s a g e P a s s i n g
593C-----------------------------------------------
594#include "spmd.inc"
595C-----------------------------------------------
596 class(t_cg_solver), INTENT(INOUT) :: this
597 INTEGER, INTENT(IN) :: DIM
598 DOUBLE PRECISION, DIMENSION(DIM), INTENT(OUT), TARGET :: SOL
599C-----------------------------------------------
600C L o c a l V a r i a b l e s
601C-----------------------------------------------
602 INTEGER :: ITER, SYSTEM_SIZE, IRHS, II, I, J, MAT_NNZ
603 my_real :: error, norm_init
604 my_real :: alpha, beta
605 ! a sortir sous forme de parametre
606 INTEGER :: MAX_ITER
607 my_real :: tol
608
609 tol = 1.d-8
610
611 system_size = dim / this%NRHS
612 max_iter = system_size
613
614! diaginal matrix made of inverse of square root of diagonal elements of the
615! system matrix
616 mat_nnz = this%MAT%GET_DIM()
617 DO ii = 1, mat_nnz
618 i = this%MAT%IROW(ii)
619 j = this%MAT%JCOL(ii)
620 IF (i == j) THEN
621 this%DIAG(i) = one / sqrt(this%MAT%VAL(ii))
622 ENDIF
623 ENDDO
624
625
626 DO irhs = 1, this%NRHS
627 this%SOL_VEC%VAL(1:system_size) = zero
628! initialisation du solver
629 CALL prod_vec(this%MAT, this%SOL_VEC, this%TEMP)
630 this%R%VAL(1:system_size) = this%RHS%VAL(system_size * (irhs - 1) + 1 : system_size * (irhs - 1) + system_size) -
631 . this%TEMP%VAL(1:system_size)
632 this%P%VAL(1:system_size) = this%R%VAL(1:system_size)
633 norm_init = this%R%NORM()
634 error = norm_init
635 iter = 0
636 DO WHILE (iter <= max_iter .AND. error > tol)
637 iter = iter + 1
638 CALL prod_vec(this%MAT, this%P, this%TEMP)
639 alpha = dot_product(this%R%VAL(1:system_size),this% R%VAL(1:system_size)) /
640 . dot_product(this%TEMP%VAL(1:system_size), this%P%VAL(1:system_size))
641 DO ii = 1, system_size
642 this%SOL_VEC%VAL(ii) = this%SOL_VEC%VAL(ii) + alpha * this%P%VAL(ii)
643 this%RNEW%VAL(ii) = this%R%VAL(ii) - alpha * this%TEMP%VAL(ii)
644 ENDDO
645 beta = dot_product(this%RNEW%VAL(1:system_size), this%RNEW%VAL(1:system_size)) /
646 . dot_product(this%R%VAL(1:system_size), this%R%VAL(1:system_size))
647 DO ii = 1, system_size
648 this%P%VAL(ii) = this%RNEW%VAL(ii) + beta * this%P%VAL(ii)
649 this%R%VAL(ii) = this%RNEW%VAL(ii)
650 ENDDO
651 error = this%R%NORM() / norm_init
652 ENDDO
653 sol(system_size * (irhs - 1) + 1:system_size * (irhs - 1) + system_size) =
654 . this%SOL_VEC%VAL(1:system_size)
655 ENDDO
656
657
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35

◆ terminate()

subroutine linear_solver_mod::terminate ( class (t_linear_solver), intent(inout) this)

Definition at line 270 of file linear_solver_mod.F.

271C-----------------------------------------------
272C I m p l i c i t T y p e s
273C-----------------------------------------------
274 USE spmd_comm_world_mod, ONLY : spmd_comm_world
275#include "implicit_f.inc"
276 class(t_linear_solver), INTENT(INOUT) :: this
277 SELECT TYPE(this)
278#ifdef MUMPS5
279 TYPE IS (t_mumps_solver)
280 CALL this%TERMINATE_MUMPS()
281#endif
282 TYPE IS (t_cg_solver)
283 CALL this%TERMINATE_CG()
284 CLASS DEFAULT
285 CALL this%ERROR()
286 END SELECT

◆ terminate_cg()

subroutine linear_solver_mod::terminate_cg ( class (t_cg_solver), intent(inout) this)

Definition at line 667 of file linear_solver_mod.F.

668C-----------------------------------------------
669C I m p l i c i t T y p e s
670C-----------------------------------------------
671 USE spmd_comm_world_mod, ONLY : spmd_comm_world
672#include "implicit_f.inc"
673 class(t_cg_solver), INTENT(INOUT) :: this
674 CALL this%SOL_VEC%DESTROY()
675 CALL this%R%DESTROY()
676 CALL this%TEMP%DESTROY()
677 CALL this%P%DESTROY()
678 CALL this%RNEW%DESTROY()
679 DEALLOCATE(this%DIAG)