FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_matrix_dump.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!-------------------------------------------------------------------------------
5
7 use hecmw_util
10
11 private
12
17
18 public :: hecmw_mat_dump
19 public :: hecmw_mat_dump_rhs
21
22 integer(kind=kint), parameter :: hecmw_mat_dump_type_none = 0
23 integer(kind=kint), parameter :: hecmw_mat_dump_type_mm = 1
24 integer(kind=kint), parameter :: hecmw_mat_dump_type_csr = 2
25 integer(kind=kint), parameter :: hecmw_mat_dump_type_bsr = 3
26
27 integer, save :: numcall = 0
28
29contains
30
31 subroutine hecmw_mat_dump( hecMAT, hecMESH )
32 implicit none
33 type(hecmwst_matrix) :: hecmat
34 type(hecmwst_local_mesh) :: hecmesh
35 numcall = numcall + 1
36 select case( hecmw_mat_get_dump(hecmat) )
38 return
40 call hecmw_mat_dump_mm(hecmat)
42 call hecmw_mat_dump_csr(hecmat)
44 call hecmw_mat_dump_bsr(hecmat)
45 end select
46 call hecmw_mat_dump_rhs(hecmat)
47 if (hecmw_mat_get_dump_exit(hecmat) /= 0) then
48 call hecmw_barrier( hecmesh )
49 stop "Exiting program after dumping matrix"
50 end if
51 end subroutine hecmw_mat_dump
52
53 subroutine make_file_name(ext, fname)
54 implicit none
55 character(*) :: ext
56 character(*) :: fname
57 write(fname,"('dump_matrix_',I0,'_',I0,A)") &
58 numcall, hecmw_comm_get_rank(), ext
59 end subroutine make_file_name
60
61 subroutine hecmw_mat_dump_mm( hecMAT )
62 implicit none
63 type(hecmwst_matrix) :: hecmat
64 integer, parameter :: idump = 201
65 character(len=64) :: fname
66 integer :: i, j, i0, j0, idof, jdof, ii, jj
67 integer :: idxl0, idxl, idxd, idxu0, idxu
68 integer :: n, np, ndof, ndof2, nnz
69 character(len=64), parameter :: lineformat = "(I0,' ',I0,' ',e20.12e3)"
70 integer :: stat
71 !n = hecMAT%N
72 n = hecmat%NP
73 np = hecmat%NP
74 ndof = hecmat%NDOF
75 ndof2 = ndof * ndof
76 ! make fname
77 call make_file_name('.mm', fname)
78 ! open file
79 open(idump, file=fname, status='replace', iostat=stat)
80 if (stat /= 0) then
81 write(*,*) 'WARNING: cannot open file ', fname, ' for matrix dump'
82 return
83 end if
84 ! header
85 write(idump,"(A)") '%%MatrixMarket matrix coordinate real general'
86 nnz = ndof2 * (n + hecmat%indexL(n) + hecmat%indexU(n))
87 write(idump,"(I0,' ',I0,' ',I0)") n*ndof, np*ndof, nnz
88 idxd = 0
89 do i = 1, n
90 i0 = (i-1)*ndof
91 do idof = 1, ndof
92 ii = i0 + idof
93 ! Lower
94 do j = hecmat%indexL(i-1)+1,hecmat%indexL(i)
95 j0 = (hecmat%itemL(j)-1)*ndof
96 idxl0 = (j-1)*ndof2 + (idof-1)*ndof
97 do jdof = 1, ndof
98 jj = j0 + jdof
99 idxl = idxl0 + jdof
100 write(idump,lineformat) ii, jj, hecmat%AL(idxl)
101 end do
102 end do
103 ! Diagonal
104 j0 = i0
105 do jdof = 1, ndof
106 jj = j0 + jdof
107 idxd = idxd + 1
108 write(idump,lineformat) ii, jj, hecmat%D(idxd)
109 end do
110 ! Upper
111 do j = hecmat%indexU(i-1)+1,hecmat%indexU(i)
112 j0 = (hecmat%itemU(j)-1)*ndof
113 idxu0 = (j-1)*ndof2 + (idof-1)*ndof
114 do jdof = 1, ndof
115 jj = j0 + jdof
116 idxu = idxu0 + jdof
117 write(idump,lineformat) ii, jj, hecmat%AU(idxu)
118 end do
119 end do
120 end do
121 end do
122 ! close file
123 close(idump)
124 end subroutine hecmw_mat_dump_mm
125
126 subroutine hecmw_mat_dump_csr( hecMAT )
127 implicit none
128 type(hecmwst_matrix) :: hecmat
129 integer, parameter :: idump = 201
130 character(len=64) :: fname
131 integer :: i, j, i0, j0, idof, jdof, ii, jj
132 integer :: idx, idxd, idxl, idxu, idxl0, idxu0
133 integer :: n, np, ndof, ndof2, nnz, nnz1
134 character(len=64), parameter :: lineformat = "(e20.12e3)"
135 integer :: stat
136 !n = hecMAT%N
137 n = hecmat%NP
138 np = hecmat%NP
139 ndof = hecmat%NDOF
140 ndof2 = ndof * ndof
141 ! make fname
142 call make_file_name('.csr', fname)
143 ! open file
144 open(idump, file=fname, status='replace', iostat=stat)
145 if (stat /= 0) then
146 write(*,*) 'WARNING: cannot open file ', fname, ' for matrix dump'
147 return
148 end if
149 ! header
150 write(idump,"(A)") '%%CSR matrix real general'
151 nnz = ndof2 * (n + hecmat%indexL(n) + hecmat%indexU(n))
152 write(idump,"(A)") '% nrow ncol nnonzero'
153 write(idump,"(I0,' ',I0,' ',I0)") n*ndof, np*ndof, nnz
154 ! index
155 write(idump,"(A)") '% index(0:nrow)'
156 idx = 0
157 write(idump, "(I0)") idx
158 do i = 1, n
159 nnz1 = ndof * ((hecmat%indexL(i)-hecmat%indexL(i-1)) + &
160 1 + (hecmat%indexU(i)-hecmat%indexU(i-1)))
161 do idof = 1, ndof
162 idx = idx + nnz1
163 write(idump, "(I0)") idx
164 end do
165 end do
166 ! item
167 write(idump,"(A)") '% item(1:nnonzero)'
168 do i = 1, n
169 i0 = (i-1)*ndof
170 do idof = 1, ndof
171 ! Lower
172 do j = hecmat%indexL(i-1)+1,hecmat%indexL(i)
173 j0 = (hecmat%itemL(j)-1)*ndof
174 do jdof = 1, ndof
175 jj = j0 + jdof
176 write(idump,"(I0)") jj
177 end do
178 end do
179 ! Diagonal
180 j0 = i0
181 do jdof = 1, ndof
182 jj = j0 + jdof
183 write(idump,"(I0)") jj
184 end do
185 ! Upper
186 do j = hecmat%indexU(i-1)+1,hecmat%indexU(i)
187 j0 = (hecmat%itemU(j)-1)*ndof
188 do jdof = 1, ndof
189 jj = j0 + jdof
190 write(idump,"(I0)") jj
191 end do
192 end do
193 end do
194 end do
195 ! values
196 write(idump,"(A)") '% value(1:nnonzero)'
197 idxd = 0
198 do i = 1, n
199 i0 = (i-1)*ndof
200 do idof = 1, ndof
201 ii = i0 + idof
202 ! Lower
203 do j = hecmat%indexL(i-1)+1,hecmat%indexL(i)
204 j0 = (hecmat%itemL(j)-1)*ndof
205 idxl0 = (j-1)*ndof2 + (idof-1)*ndof
206 do jdof = 1, ndof
207 jj = j0 + jdof
208 idxl = idxl0+jdof
209 write(idump,lineformat) hecmat%AL(idxl)
210 end do
211 end do
212 ! Diagonal
213 j0 = i0
214 do jdof = 1, ndof
215 jj = j0 + jdof
216 idxd = idxd + 1
217 write(idump,lineformat) hecmat%D(idxd)
218 end do
219 ! Upper
220 do j = hecmat%indexU(i-1)+1,hecmat%indexU(i)
221 j0 = (hecmat%itemU(j)-1)*ndof
222 idxu0 = (j-1)*ndof2 + (idof-1)*ndof
223 do jdof = 1, ndof
224 jj = j0 + jdof
225 idxu = idxu0 + jdof
226 write(idump,lineformat) hecmat%AU(idxu)
227 end do
228 end do
229 end do
230 end do
231 ! close file
232 close(idump)
233 end subroutine hecmw_mat_dump_csr
234
235 subroutine hecmw_mat_dump_bsr( hecMAT )
236 implicit none
237 type(hecmwst_matrix) :: hecmat
238 integer, parameter :: idump = 201
239 character(len=64) :: fname
240 integer :: i, j
241 integer :: idx, idxl0, idxd0, idxu0
242 integer :: n, np, ndof, ndof2, nnz, nnz1
243 character(len=64), parameter :: lineformat = "(e20.12e3)"
244 integer :: stat
245 !n = hecMAT%N
246 n = hecmat%NP
247 np = hecmat%NP
248 ndof = hecmat%NDOF
249 ndof2 = ndof * ndof
250 ! make fname
251 call make_file_name('.bsr', fname)
252 ! open file
253 open(idump, file=fname, status='replace', iostat=stat)
254 if (stat /= 0) then
255 write(*,*) 'WARNING: cannot open file ', fname, ' for matrix dump'
256 return
257 end if
258 ! header
259 write(idump,"(A)") '%%Block-CSR matrix real general'
260 nnz = n + hecmat%indexL(n) + hecmat%indexU(n)
261 write(idump,"(A)") '% nrow ncol nnonzero ndof'
262 write(idump,"(I0,' ',I0,' ',I0,' ',I0)") n, np, nnz, ndof
263 ! index
264 write(idump,"(A)") '% index(0:nrow)'
265 idx = 0
266 write(idump, "(I0)") idx
267 do i = 1, n
268 nnz1 = (hecmat%indexL(i)-hecmat%indexL(i-1)) + &
269 1 + (hecmat%indexU(i)-hecmat%indexU(i-1))
270 idx = idx + nnz1
271 write(idump, "(I0)") idx
272 end do
273 ! item
274 write(idump,"(A)") '% item(1:nnonzero)'
275 do i = 1, n
276 ! Lower
277 do j = hecmat%indexL(i-1)+1,hecmat%indexL(i)
278 write(idump,"(I0)") hecmat%itemL(j)
279 end do
280 ! Diagonal
281 write(idump,"(I0)") i
282 ! Upper
283 do j = hecmat%indexU(i-1)+1,hecmat%indexU(i)
284 write(idump,"(I0)") hecmat%itemU(j)
285 end do
286 end do
287 ! values
288 write(idump,"(A)") '% value(1:nnonzero*ndof*ndof)'
289 idxd0 = 0
290 do i = 1, n
291 ! Lower
292 do j = hecmat%indexL(i-1)+1,hecmat%indexL(i)
293 idxl0 = (j-1)*ndof2
294 write(idump,lineformat) hecmat%AL(idxl0+1:idxl0+ndof2)
295 end do
296 ! Diagonal
297 write(idump,lineformat) hecmat%D(idxd0+1:idxd0+ndof2)
298 idxd0 = idxd0 + ndof2
299 ! Upper
300 do j = hecmat%indexU(i-1)+1,hecmat%indexU(i)
301 idxu0 = (j-1)*ndof2
302 write(idump,lineformat) hecmat%AU(idxu0+1:idxu0+ndof2)
303 end do
304 end do
305 ! close file
306 close(idump)
307 end subroutine hecmw_mat_dump_bsr
308
309 subroutine hecmw_mat_dump_rhs( hecMAT )
310 implicit none
311 type(hecmwst_matrix) :: hecmat
312 integer, parameter :: idump = 201
313 character(len=64) :: fname
314 integer :: i
315 integer :: n, np, ndof, ndof2
316 character(len=64), parameter :: lineformat = "(e20.12e3)"
317 integer :: stat
318 if( hecmw_mat_get_dump(hecmat) == hecmw_mat_dump_type_none) return
319 !n = hecMAT%N
320 n = hecmat%NP
321 np = hecmat%NP
322 ndof = hecmat%NDOF
323 ndof2 = ndof * ndof
324 ! make fname
325 call make_file_name('.rhs', fname)
326 ! open file
327 open(idump, file=fname, status='replace', iostat=stat)
328 if (stat /= 0) then
329 write(*,*) 'WARNING: cannot open file ', fname, ' for matrix dump'
330 return
331 end if
332 do i = 1, np*ndof
333 write(idump,lineformat) hecmat%B(i)
334 end do
335 ! close file
336 close(idump)
337 end subroutine hecmw_mat_dump_rhs
338
339 subroutine hecmw_mat_dump_solution( hecMAT )
340 implicit none
341 type(hecmwst_matrix) :: hecmat
342 integer, parameter :: idump = 201
343 character(len=64) :: fname
344 integer :: i
345 integer :: n, np, ndof, ndof2
346 character(len=64), parameter :: lineformat = "(e20.12e3)"
347 integer :: stat
348 if( hecmw_mat_get_dump(hecmat) == hecmw_mat_dump_type_none) return
349 !n = hecMAT%N
350 n = hecmat%NP
351 np = hecmat%NP
352 ndof = hecmat%NDOF
353 ndof2 = ndof * ndof
354 ! make fname
355 call make_file_name('.sol', fname)
356 ! open file
357 open(idump, file=fname, status='replace', iostat=stat)
358 if (stat /= 0) then
359 write(*,*) 'WARNING: cannot open file ', fname, ' for matrix dump'
360 return
361 end if
362 do i = 1, np*ndof
363 write(idump,lineformat) hecmat%X(i)
364 end do
365 ! close file
366 close(idump)
367 end subroutine hecmw_mat_dump_solution
368
369end module hecmw_matrix_dump
integer(kind=kint), parameter, public hecmw_mat_dump_type_mm
integer(kind=kint), parameter, public hecmw_mat_dump_type_csr
subroutine, public hecmw_mat_dump(hecmat, hecmesh)
integer(kind=kint), parameter, public hecmw_mat_dump_type_bsr
subroutine, public hecmw_mat_dump_rhs(hecmat)
integer(kind=kint), parameter, public hecmw_mat_dump_type_none
subroutine, public hecmw_mat_dump_solution(hecmat)
integer(kind=kint) function, public hecmw_mat_get_dump(hecmat)
integer(kind=kint) function, public hecmw_mat_get_dump_exit(hecmat)
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=kint) function hecmw_comm_get_rank()
subroutine hecmw_barrier(hecmesh)