FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_MUMPS_wrapper.F90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2! Copyright (c) 2019 FrontISTR Commons
3! This software is released under the MIT License, see LICENSE.txt
4!-------------------------------------------------------------------------------
7 use hecmw_util
9
10#ifdef HECMW_WITH_MUMPS
12 include 'dmumps_struc.h'
13#endif
14
15 private
16 public :: hecmw_mumps_wrapper
17
18#ifdef HECMW_WITH_MUMPS
19 type (dmumps_struc), save :: mumps_par
20#endif
21
22contains
23
24 subroutine hecmw_mumps_wrapper(spMAT, job, istat)
25 implicit none
26 type (sparse_matrix), intent(inout) :: spmat
27 integer(kind=kint), intent(in) :: job
28 integer(kind=kint), intent(out) :: istat
29
30#ifdef HECMW_WITH_MUMPS
31 integer(kind=kint) :: ierr,myrank
32
33 myrank=hecmw_comm_get_rank()
34
35 if (spmat%type /= sparse_matrix_type_coo) then
36 write(*,*) 'ERROR: MUMPS require COO type sparse matrix'
38 endif
39
40 if (job==-1) then
41 mumps_par%COMM = hecmw_comm_get_comm()
42 mumps_par%JOB = -1
43 if (spmat%symtype == sparse_matrix_symtype_spd) then
44 ! mumps_par%SYM = 1
45 mumps_par%SYM = 2 ! general symmetric
46 mumps_par%CNTL(1) = 0.0d0 ! avoid numerical pivoting
47 else if (spmat%symtype == sparse_matrix_symtype_sym) then
48 mumps_par%SYM = 2
49 else
50 mumps_par%SYM = 0
51 endif
52 mumps_par%PAR = 1
53 elseif (job>0) then
54 call set_mumps_pointers(mumps_par, spmat)
55 if (job==3 .or. job==5 .or. job==6) then
56 if (myrank == 0) then
57 allocate(mumps_par%RHS(mumps_par%N), stat=ierr)
58 else
59 allocate(mumps_par%RHS(1), stat=ierr)
60 endif
61 if (ierr /= 0) then
62 write(*,*) " Allocation error, mumps_par%RHS"
64 endif
65 call sparse_matrix_gather_rhs(spmat, mumps_par%RHS)
66 endif
67 endif
68
69 if (spmat%timelog == 2) then
70 mumps_par%ICNTL(1)=6
71 mumps_par%ICNTL(2)=0
72 mumps_par%ICNTL(3)=6
73 mumps_par%ICNTL(4)=2
74 elseif (spmat%timelog == 1) then
75 mumps_par%ICNTL(1)=6
76 mumps_par%ICNTL(2)=0
77 mumps_par%ICNTL(3)=6
78 mumps_par%ICNTL(4)=1
79 else
80 mumps_par%ICNTL(1)=6
81 mumps_par%ICNTL(2)=0
82 mumps_par%ICNTL(3)=0
83 mumps_par%ICNTL(4)=0
84 endif
85
86 mumps_par%JOB = job
87 do
88 call dmumps(mumps_par)
89 istat = mumps_par%INFOG(1)
90 if (istat >= 0) exit
91 if (istat == -9 .and. mumps_par%ICNTL(14) < 200) then
92 mumps_par%ICNTL(14) = mumps_par%ICNTL(14) + 20
93 if (myrank == 0) &
94 write(*,*) 'INFO: MUMPS increasing relaxation parameter to', &
95 mumps_par%ICNTL(14)
96 elseif (istat < 0) then
97 if (myrank == 0) then
98 write(*,*) 'ERROR: MUMPS job=',job,&
99 ', INFOG(1)=',istat,', INFOG(2)=',mumps_par%INFOG(2)
100 endif
101 return
102 endif
103 enddo
104
105 if (job==-1) then
106 ! ordering: 0:auto, 1:seq, 2:par
107 mumps_par%ICNTL(28)=0
108 ! seq ord: 0:AMD, 1:USER, 2:AMF, 3:scotch, 4:pord, 5:metis, 6:QAMD, 7:auto
109 mumps_par%ICNTL(7)=7
110 ! par ord: 0:auto, 1:ptscotch, 2:parmetis
111 mumps_par%ICNTL(29)=0
112 ! relaxation parameter
113 mumps_par%ICNTL(14)=20
114 ! iterative refinement
115 mumps_par%ICNTL(10)=3
116 mumps_par%CNTL(2)=1.0e-8
117 ! Out-Of-Core: 0:IN-CORE only, 1:OOC
118 mumps_par%ICNTL(22)=0
119 endif
120 if (job==3 .or. job==5 .or. job==6) then
121 call sparse_matrix_scatter_rhs(spmat, mumps_par%RHS)
122 deallocate(mumps_par%RHS)
123 endif
124
125#else
126 stop "MUMPS not available"
127#endif
128 end subroutine hecmw_mumps_wrapper
129
130#ifdef HECMW_WITH_MUMPS
131 subroutine set_mumps_pointers(mumps_par, spMAT)
132 implicit none
133 type (dmumps_struc), intent(inout) :: mumps_par
134 type (sparse_matrix), intent(in) :: spmat
135 mumps_par%N = spmat%N
136 ! Distributed assembled matrix input
137 mumps_par%ICNTL(18) = 3
138 mumps_par%NZ_loc = spmat%NZ
139 mumps_par%IRN_loc => spmat%IRN
140 mumps_par%JCN_loc => spmat%JCN
141 mumps_par%A_loc => spmat%A
142 end subroutine set_mumps_pointers
143#endif
144
145end module m_hecmw_mumps_wrapper
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=kint) function hecmw_comm_get_comm()
integer(kind=kint) function hecmw_comm_get_rank()
subroutine hecmw_abort(comm)
This module provides wrapper for parallel sparse direct solver MUMPS.
subroutine, public hecmw_mumps_wrapper(spmat, job, istat)
This module provides DOF based sparse matrix data structure (CSR and COO)
integer(kind=kint), parameter, public sparse_matrix_type_coo
integer(kind=kint), parameter, public sparse_matrix_symtype_sym
subroutine, public sparse_matrix_gather_rhs(spmat, rhs_all)
integer(kind=kint), parameter, public sparse_matrix_symtype_spd
subroutine, public sparse_matrix_scatter_rhs(spmat, rhs_all)