FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
sparse_matrix_hec.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!-------------------------------------------------------------------------------
8 use hecmw_util
11 implicit none
12
13 private
14
21
22contains
23
24 !!! public subroutines
25
26 subroutine sparse_matrix_hec_init_prof(spMAT, hecMAT, hecMESH)
27 type (sparse_matrix), intent(inout) :: spmat
28 type (hecmwst_matrix), intent(in) :: hecmat
29 type (hecmwst_local_mesh), intent(in) :: hecmesh
30 integer(kind=kint) :: ndof, ndof2, n_loc, nl, nu, nz
31 ndof=hecmat%NDOF; ndof2=ndof*ndof
32 n_loc=hecmat%N*ndof
33 if (sparse_matrix_is_sym(spmat)) then
34 nu=hecmat%indexU(hecmat%N)
35 nz=hecmat%N*(ndof2+ndof)/2+nu*ndof2
36 else
37 nl=hecmat%indexL(hecmat%N)
38 nu=hecmat%indexU(hecmat%N)
39 nz=(hecmat%N+nu+nl)*ndof2
40 endif
41 call sparse_matrix_init(spmat, n_loc, nz)
42 call sparse_matrix_hec_set_conv_ext(spmat, hecmesh, hecmat%NDOF)
43 spmat%iterlog = hecmat%Iarray(21)
44 spmat%timelog = hecmat%Iarray(22)
45 call sparse_matrix_hec_set_prof(spmat, hecmat)
46 end subroutine sparse_matrix_hec_init_prof
47
48 subroutine sparse_matrix_hec_set_conv_ext(spMAT, hecMESH, ndof)
49 type(sparse_matrix), intent(inout) :: spmat
50 type (hecmwst_local_mesh), intent(in) :: hecmesh
51 integer(kind=kint), intent(in) :: ndof
52 integer(kind=kint) :: i,j,nn_external,id,ierr
53 integer(kint) :: pid,lid,j0
54 if (hecmesh%n_neighbor_pe==0) return
55 ! create conversion list
56 nn_external = hecmesh%n_node - hecmesh%nn_internal
57 allocate(spmat%conv_ext(nn_external*ndof), stat=ierr)
58 if (ierr /= 0) then
59 write(*,*) " Allocation error, spMAT%conv_ext"
61 endif
62 spmat%conv_ext(:) = -1
63 do i=1,nn_external
64 id = i + hecmesh%nn_internal
65 pid = hecmesh%node_ID(id*2)
66 lid = hecmesh%node_ID(id*2-1)
67 j0 = spmat%DISPLS(pid+1) + (lid-1)*ndof
68 do j=1,ndof
69 spmat%conv_ext((i-1)*ndof+j) = j0+j
70 enddo
71 enddo
73
74 subroutine sparse_matrix_hec_set_prof(spMAT, hecMAT)
75 type(sparse_matrix), intent(inout) :: spmat
76 type(hecmwst_matrix), intent(in) :: hecmat
77 integer(kind=kint) :: ndof, ndof2
78 integer(kind=kint) :: m, i, idof, i0, ii, ls, le, l, j, j0, jdof, jdofs
79 !integer(kind=kint) :: offset_l, offset_d, offset_u
80 ! CONVERT TO CSR or COO STYLE
81 ndof=hecmat%NDOF; ndof2=ndof*ndof
82 m=1
83 ii = 0
84 do i=1,hecmat%N
85 do idof=1,ndof
86 i0=spmat%offset+ndof*(i-1)
87 ii=i0+idof
88 if (spmat%type==sparse_matrix_type_csr) spmat%IRN(ii-spmat%offset)=m
89 ! Lower
90 if (.not. sparse_matrix_is_sym(spmat)) then
91 ls=hecmat%indexL(i-1)+1
92 le=hecmat%indexL(i)
93 do l=ls,le
94 j=hecmat%itemL(l)
95 !if (j <= hecMAT%N) then
96 j0=spmat%offset+ndof*(j-1)
97 !else
98 ! j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
99 !endif
100 !offset_l=ndof2*(l-1)+ndof*(idof-1)
101 do jdof=1,ndof
102 if (spmat%type==sparse_matrix_type_coo) spmat%IRN(m)=ii
103 spmat%JCN(m)=j0+jdof
104 !spMAT%A(m)=hecMAT%AL(offset_l+jdof)
105 m=m+1
106 enddo
107 enddo
108 endif
109 ! Diag
110 !offset_d=ndof2*(i-1)+ndof*(idof-1)
111 if (sparse_matrix_is_sym(spmat)) then; jdofs=idof; else; jdofs=1; endif
112 do jdof=jdofs,ndof
113 if (spmat%type==sparse_matrix_type_coo) spmat%IRN(m)=ii
114 spmat%JCN(m)=i0+jdof
115 !spMAT%A(m)=hecMAT%D(offset_d+jdof)
116 m=m+1
117 enddo
118 ! Upper
119 ls=hecmat%indexU(i-1)+1
120 le=hecmat%indexU(i)
121 do l=ls,le
122 j=hecmat%itemU(l)
123 if (j <= hecmat%N) then
124 j0=spmat%offset+ndof*(j-1)
125 else
126 j0=spmat%conv_ext(ndof*(j-hecmat%N))-ndof
127 if (sparse_matrix_is_sym(spmat) .and. j0 < i0) cycle
128 endif
129 !offset_u=ndof2*(l-1)+ndof*(idof-1)
130 do jdof=1,ndof
131 if (spmat%type==sparse_matrix_type_coo) spmat%IRN(m)=ii
132 spmat%JCN(m)=j0+jdof
133 !spMAT%A(m)=hecMAT%AU(offset_u+jdof)
134 m=m+1
135 enddo
136 enddo
137 enddo
138 enddo
139 if (spmat%type == sparse_matrix_type_csr) spmat%IRN(ii+1-spmat%offset)=m
140 if (sparse_matrix_is_sym(spmat) .and. m-1 < spmat%NZ) spmat%NZ=m-1
141 if (m-1 /= spmat%NZ) then
142 write(*,*) 'ERROR: sparse_matrix_set_ij on rank ',hecmw_comm_get_rank()
143 write(*,*) 'm-1 = ',m-1,', NZ=',spmat%NZ
144 stop
145 endif
146 end subroutine sparse_matrix_hec_set_prof
147
148 subroutine sparse_matrix_hec_set_vals(spMAT, hecMAT)
149 type(sparse_matrix), intent(inout) :: spmat
150 type(hecmwst_matrix), intent(in) :: hecmat
151 integer(kind=kint) :: ndof, ndof2
152 integer(kind=kint) :: m, i, idof, i0, ii, ls, le, l, j, j0, jdof, jdofs
153 integer(kind=kint) :: offset_l, offset_d, offset_u
154 ndof=hecmat%NDOF; ndof2=ndof*ndof
155 ii = 0
156 m=1
157 do i=1,hecmat%N
158 do idof=1,ndof
159 i0=spmat%offset+ndof*(i-1)
160 ii=i0+idof
161 if (spmat%type == sparse_matrix_type_csr) then
162 if (spmat%IRN(ii-spmat%offset)/=m) stop "ERROR: sparse_matrix_set_a1"
163 endif
164 ! Lower
165 if (.not. sparse_matrix_is_sym(spmat)) then
166 ls=hecmat%indexL(i-1)+1
167 le=hecmat%indexL(i)
168 do l=ls,le
169 j=hecmat%itemL(l)
170 !if (j <= hecMAT%N) then
171 j0=spmat%offset+ndof*(j-1)
172 !else
173 ! j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
174 !endif
175 offset_l=ndof2*(l-1)+ndof*(idof-1)
176 do jdof=1,ndof
177 if (spmat%type==sparse_matrix_type_coo) then
178 if (spmat%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a2"
179 endif
180 if (spmat%type == sparse_matrix_type_csr) spmat%JCN(m)=j0+jdof
181 if (spmat%JCN(m)/=j0+jdof) stop "ERROR: sparse_matrix_set_a3"
182 spmat%A(m)=hecmat%AL(offset_l+jdof)
183 m=m+1
184 enddo
185 enddo
186 endif
187 ! Diag
188 offset_d=ndof2*(i-1)+ndof*(idof-1)
189 if (sparse_matrix_is_sym(spmat)) then; jdofs=idof; else; jdofs=1; endif
190 do jdof=jdofs,ndof
191 if (spmat%type==sparse_matrix_type_coo) then
192 if (spmat%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a4"
193 endif
194 if (spmat%type == sparse_matrix_type_csr) spmat%JCN(m)=i0+jdof
195 if (spmat%JCN(m)/=i0+jdof) stop "ERROR: sparse_matrix_set_a5"
196 spmat%A(m)=hecmat%D(offset_d+jdof)
197 m=m+1
198 enddo
199 ! Upper
200 ls=hecmat%indexU(i-1)+1
201 le=hecmat%indexU(i)
202 do l=ls,le
203 j=hecmat%itemU(l)
204 if (j <= hecmat%N) then
205 j0=spmat%offset+ndof*(j-1)
206 else
207 j0=spmat%conv_ext(ndof*(j-hecmat%N))-ndof
208 if (sparse_matrix_is_sym(spmat) .and. j0 < i0) cycle
209 endif
210 offset_u=ndof2*(l-1)+ndof*(idof-1)
211 do jdof=1,ndof
212 if (spmat%type==sparse_matrix_type_coo) then
213 if (spmat%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a6"
214 endif
215 if (spmat%type == sparse_matrix_type_csr) spmat%JCN(m)=j0+jdof
216 if (spmat%JCN(m)/=j0+jdof) stop "ERROR: sparse_matrix_set_a7"
217 spmat%A(m)=hecmat%AU(offset_u+jdof)
218 m=m+1
219 enddo
220 enddo
221 enddo
222 enddo
223 if (spmat%type == sparse_matrix_type_csr) then
224 if (spmat%IRN(ii+1-spmat%offset)/=m) stop "ERROR: sparse_matrix_set_a8"
225 endif
226 if (m-1 /= spmat%NZ) stop "ERROR: sparse_matrix_set_a9"
227 end subroutine sparse_matrix_hec_set_vals
228
229 subroutine sparse_matrix_hec_set_rhs(spMAT, hecMAT)
230 implicit none
231 type (sparse_matrix), intent(inout) :: spmat
232 type (hecmwst_matrix), intent(in) :: hecmat
233 integer(kind=kint) :: ierr,i
234 allocate(spmat%rhs(spmat%N_loc), stat=ierr)
235 if (ierr /= 0) then
236 write(*,*) " Allocation error, spMAT%rhs"
238 endif
239 do i=1,spmat%N_loc
240 spmat%rhs(i)=hecmat%b(i)
241 enddo
242 end subroutine sparse_matrix_hec_set_rhs
243
244 subroutine sparse_matrix_hec_get_rhs(spMAT, hecMAT)
245 implicit none
246 type (sparse_matrix), intent(inout) :: spmat
247 type (hecmwst_matrix), intent(inout) :: hecmat
248 integer(kind=kint) :: i
249 do i=1,spmat%N_loc
250 hecmat%x(i)=spmat%rhs(i)
251 enddo
252 deallocate(spmat%rhs)
253 end subroutine sparse_matrix_hec_get_rhs
254
255end module m_sparse_matrix_hec
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 conversion routines between HEC data structure and DOF based sparse matrix struc...
subroutine, public sparse_matrix_hec_set_rhs(spmat, hecmat)
subroutine, public sparse_matrix_hec_set_vals(spmat, hecmat)
subroutine, public sparse_matrix_hec_set_prof(spmat, hecmat)
subroutine, public sparse_matrix_hec_set_conv_ext(spmat, hecmesh, ndof)
subroutine, public sparse_matrix_hec_init_prof(spmat, hecmat, hecmesh)
subroutine, public sparse_matrix_hec_get_rhs(spmat, hecmat)
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_type_csr
subroutine, public sparse_matrix_init(spmat, n_loc, nz)
logical function, public sparse_matrix_is_sym(spmat)