FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_matrix_misc.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 implicit none
11
12 private
13 public :: hecmw_mat_clear
14 public :: hecmw_mat_clear_b
15 public :: hecmw_mat_init
16 public :: hecmw_mat_finalize
18 public :: hecmw_mat_copy_val
19
20 public :: hecmw_mat_set_iter
21 public :: hecmw_mat_get_iter
22 public :: hecmw_mat_set_method
23 public :: hecmw_mat_get_method
24 public :: hecmw_mat_set_precond
25 public :: hecmw_mat_get_precond
26 public :: hecmw_mat_set_nset
27 public :: hecmw_mat_get_nset
30 public :: hecmw_mat_set_nrest
31 public :: hecmw_mat_get_nrest
32 public :: hecmw_mat_set_scaling
33 public :: hecmw_mat_get_scaling
40 public :: hecmw_mat_set_estcond
41 public :: hecmw_mat_get_estcond
42 public :: hecmw_mat_set_iterlog
43 public :: hecmw_mat_get_iterlog
44 public :: hecmw_mat_set_timelog
45 public :: hecmw_mat_get_timelog
46 public :: hecmw_mat_set_dump
47 public :: hecmw_mat_get_dump
50 public :: hecmw_mat_set_usejad
51 public :: hecmw_mat_get_usejad
66
67 public :: hecmw_mat_set_method2
68 public :: hecmw_mat_get_method2
75
88
89 public :: hecmw_mat_set_resid
90 public :: hecmw_mat_get_resid
93 public :: hecmw_mat_set_sigma
94 public :: hecmw_mat_get_sigma
95 public :: hecmw_mat_set_thresh
96 public :: hecmw_mat_get_thresh
97 public :: hecmw_mat_set_filter
98 public :: hecmw_mat_get_filter
99 public :: hecmw_mat_set_penalty
100 public :: hecmw_mat_get_penalty
103
104 public :: hecmw_mat_diag_max
106 public :: hecmw_mat_substitute
107
108 integer, parameter :: IDX_I_ITER = 1
109 integer, parameter :: IDX_I_METHOD = 2
110 integer, parameter :: IDX_I_PRECOND = 3
111 integer, parameter :: IDX_I_NSET = 4
112 integer, parameter :: IDX_I_ITERPREMAX = 5
113 integer, parameter :: IDX_I_NREST = 6
114 integer, parameter :: IDX_I_SCALING = 7
115 integer, parameter :: IDX_I_PENALIZED = 11
116 integer, parameter :: IDX_I_PENALIZED_B = 12
117 integer, parameter :: IDX_I_MPC_METHOD = 13
118 integer, parameter :: IDX_I_ESTCOND = 14
119 integer, parameter :: IDX_I_ITERLOG = 21
120 integer, parameter :: IDX_I_TIMELOG = 22
121 integer, parameter :: IDX_I_DUMP = 31
122 integer, parameter :: IDX_I_DUMP_EXIT = 32
123 integer, parameter :: IDX_I_USEJAD = 33
124 integer, parameter :: IDX_I_NCOLOR_IN = 34
125 integer, parameter :: IDX_I_MAXRECYCLE_PRECOND = 35
126 integer, parameter :: IDX_I_NRECYCLE_PRECOND = 96
127 integer, parameter :: IDX_I_FLAG_NUMFACT = 97
128 integer, parameter :: IDX_I_FLAG_SYMBFACT = 98
129 integer, parameter :: IDX_I_SOLVER_TYPE = 99
130
131 integer, parameter :: IDX_I_METHOD2 = 8
132 integer, parameter :: IDX_I_FLAG_CONVERGED = 81
133 integer, parameter :: IDX_I_FLAG_DIVERGED = 82
134 integer, parameter :: IDX_I_FLAG_MPCMATVEC = 83
135
136 integer, parameter :: IDX_I_SOLVER_OPT1 = 41
137 integer, parameter :: IDX_I_SOLVER_OPT2 = 42
138 integer, parameter :: IDX_I_SOLVER_OPT3 = 43
139 integer, parameter :: IDX_I_SOLVER_OPT4 = 44
140 integer, parameter :: IDX_I_SOLVER_OPT5 = 45
141 integer, parameter :: IDX_I_SOLVER_OPT6 = 46
142
143 integer, parameter :: IDX_R_RESID = 1
144 integer, parameter :: IDX_R_SIGMA_DIAG = 2
145 integer, parameter :: IDX_R_SIGMA = 3
146 integer, parameter :: IDX_R_THRESH = 4
147 integer, parameter :: IDX_R_FILTER = 5
148 integer, parameter :: IDX_R_PENALTY = 11
149 integer, parameter :: IDX_R_PENALTY_ALPHA = 12
150
151contains
152
153 subroutine hecmw_mat_clear( hecMAT )
154 type(hecmwst_matrix) :: hecmat
155
156 hecmat%D = 0.0d0
157 hecmat%AL = 0.0d0
158 hecmat%AU = 0.0d0
159 call hecmw_cmat_clear( hecmat%cmat )
160 call hecmw_mat_set_penalized( hecmat, 0 )
161 call hecmw_mat_set_penalty_alpha( hecmat, 0.d0 )
162 end subroutine hecmw_mat_clear
163
164 subroutine hecmw_mat_clear_b( hecMAT )
165 type(hecmwst_matrix) :: hecmat
166
167 hecmat%B = 0.0d0
168 call hecmw_mat_set_penalized_b( hecmat, 0 )
169 end subroutine hecmw_mat_clear_b
170
171 subroutine hecmw_mat_init( hecMAT )
172 type(hecmwst_matrix) :: hecmat
173
174 call hecmw_nullify_matrix( hecmat )
175
176 hecmat%Iarray = 0
177 hecmat%Rarray = 0.d0
178
179 call hecmw_mat_set_iter( hecmat, 100 )
180 call hecmw_mat_set_method( hecmat, 1 )
181 call hecmw_mat_set_precond( hecmat, 1 )
182 call hecmw_mat_set_nset( hecmat, 0 )
183 call hecmw_mat_set_iterpremax( hecmat, 1 )
184 call hecmw_mat_set_nrest( hecmat, 10 )
185 call hecmw_mat_set_scaling( hecmat, 0 )
186 call hecmw_mat_set_iterlog( hecmat, 0 )
187 call hecmw_mat_set_timelog( hecmat, 0 )
188 call hecmw_mat_set_dump( hecmat, 0 )
189 call hecmw_mat_set_dump_exit( hecmat, 0 )
190 call hecmw_mat_set_usejad( hecmat, 0 )
191 call hecmw_mat_set_ncolor_in( hecmat, 10 )
192 call hecmw_mat_set_estcond( hecmat, 0 )
193 call hecmw_mat_set_maxrecycle_precond( hecmat, 3 )
194
195 call hecmw_mat_set_resid( hecmat, 1.d-8 )
196 call hecmw_mat_set_sigma_diag( hecmat, 1.d0 )
197 call hecmw_mat_set_sigma( hecmat, 0.d0 )
198 call hecmw_mat_set_thresh( hecmat, 0.10d0 )
199 call hecmw_mat_set_filter( hecmat, 0.10d0 )
200
201 call hecmw_mat_set_penalized( hecmat, 0 )
202 call hecmw_mat_set_penalty( hecmat, 1.d+4 )
203 call hecmw_mat_set_penalty_alpha( hecmat, 0.d0 )
204 call hecmw_mat_set_mpc_method( hecmat, 0 )
205
207 call hecmw_mat_set_flag_numfact( hecmat, 1 )
208 call hecmw_mat_set_flag_symbfact( hecmat, 1 )
209 call hecmw_mat_set_solver_type( hecmat, 1 )
210
211 call hecmw_mat_set_solver_opt1( hecmat, 0 )
212 call hecmw_mat_set_solver_opt2( hecmat, 0 )
213 call hecmw_mat_set_solver_opt3( hecmat, 0 )
214 call hecmw_mat_set_solver_opt4( hecmat, 0 )
215 call hecmw_mat_set_solver_opt5( hecmat, 0 )
216 call hecmw_mat_set_solver_opt6( hecmat, 0 )
217
218 call hecmw_cmat_init( hecmat%cmat )
219 end subroutine hecmw_mat_init
220
221 subroutine hecmw_mat_finalize( hecMAT )
222 type(hecmwst_matrix) :: hecmat
223 if (associated(hecmat%D)) deallocate(hecmat%D)
224 if (associated(hecmat%B)) deallocate(hecmat%B)
225 if (associated(hecmat%X)) deallocate(hecmat%X)
226 if (associated(hecmat%AL)) deallocate(hecmat%AL)
227 if (associated(hecmat%AU)) deallocate(hecmat%AU)
228 if (associated(hecmat%indexL)) deallocate(hecmat%indexL)
229 if (associated(hecmat%indexU)) deallocate(hecmat%indexU)
230 if (associated(hecmat%itemL)) deallocate(hecmat%itemL)
231 if (associated(hecmat%itemU)) deallocate(hecmat%itemU)
232 if (associated(hecmat%ALU)) deallocate(hecmat%ALU)
233 call hecmw_cmat_finalize( hecmat%cmat )
234 end subroutine hecmw_mat_finalize
235
236 subroutine hecmw_mat_copy_profile( hecMATorg, hecMAT )
237 type(hecmwst_matrix), intent(in) :: hecmatorg
238 type(hecmwst_matrix), intent(inout) :: hecmat
239 hecmat%N = hecmatorg%N
240 hecmat%NP = hecmatorg%NP
241 hecmat%NDOF = hecmatorg%NDOF
242 hecmat%NPL = hecmatorg%NPL
243 hecmat%NPU = hecmatorg%NPU
244 allocate(hecmat%indexL(size(hecmatorg%indexL)))
245 allocate(hecmat%indexU(size(hecmatorg%indexU)))
246 allocate(hecmat%itemL (size(hecmatorg%itemL )))
247 allocate(hecmat%itemU (size(hecmatorg%itemU )))
248 allocate(hecmat%D (size(hecmatorg%D )))
249 allocate(hecmat%AL(size(hecmatorg%AL)))
250 allocate(hecmat%AU(size(hecmatorg%AU)))
251 allocate(hecmat%B (size(hecmatorg%B )))
252 allocate(hecmat%X (size(hecmatorg%X )))
253 hecmat%indexL = hecmatorg%indexL
254 hecmat%indexU = hecmatorg%indexU
255 hecmat%itemL = hecmatorg%itemL
256 hecmat%itemU = hecmatorg%itemU
257 hecmat%D = 0.d0
258 hecmat%AL = 0.d0
259 hecmat%AU = 0.d0
260 hecmat%B = 0.d0
261 hecmat%X = 0.d0
262 end subroutine hecmw_mat_copy_profile
263
264 subroutine hecmw_mat_copy_val( hecMATorg, hecMAT )
265 type(hecmwst_matrix), intent(in) :: hecmatorg
266 type(hecmwst_matrix), intent(inout) :: hecmat
267 integer(kind=kint) :: ierr
268 integer(kind=kint) :: i
269 ierr = 0
270 if (hecmat%N /= hecmatorg%N) ierr = 1
271 if (hecmat%NP /= hecmatorg%NP) ierr = 1
272 if (hecmat%NDOF /= hecmatorg%NDOF) ierr = 1
273 if (hecmat%NPL /= hecmatorg%NPL) ierr = 1
274 if (hecmat%NPU /= hecmatorg%NPU) ierr = 1
275 if (ierr /= 0) then
276 write(0,*) 'ERROR: hecmw_mat_copy_val: different profile'
277 stop
278 endif
279 do i = 1, size(hecmat%D)
280 hecmat%D(i) = hecmatorg%D(i)
281 enddo
282 do i = 1, size(hecmat%AL)
283 hecmat%AL(i) = hecmatorg%AL(i)
284 enddo
285 do i = 1, size(hecmat%AU)
286 hecmat%AU(i) = hecmatorg%AU(i)
287 enddo
288 end subroutine hecmw_mat_copy_val
289
290 subroutine hecmw_mat_set_iter( hecMAT, iter )
291 type(hecmwst_matrix) :: hecmat
292 integer(kind=kint) :: iter
293
294 hecmat%Iarray(idx_i_iter) = iter
295 end subroutine hecmw_mat_set_iter
296
297 function hecmw_mat_get_iter( hecMAT )
298 integer(kind=kint) :: hecmw_mat_get_iter
299 type(hecmwst_matrix) :: hecmat
300
301 hecmw_mat_get_iter = hecmat%Iarray(idx_i_iter)
302 end function hecmw_mat_get_iter
303
304 subroutine hecmw_mat_set_method( hecMAT, method )
305 type(hecmwst_matrix) :: hecmat
306 integer(kind=kint) :: method
307
308 hecmat%Iarray(idx_i_method) = method
309 end subroutine hecmw_mat_set_method
310
311 function hecmw_mat_get_method( hecMAT )
312 integer(kind=kint) :: hecmw_mat_get_method
313 type(hecmwst_matrix) :: hecmat
314
315 hecmw_mat_get_method = hecmat%Iarray(idx_i_method)
316 end function hecmw_mat_get_method
317
318 subroutine hecmw_mat_set_method2( hecMAT, method2 )
319 type(hecmwst_matrix) :: hecmat
320 integer(kind=kint) :: method2
321
322 hecmat%Iarray(idx_i_method2) = method2
323 end subroutine hecmw_mat_set_method2
324
325 function hecmw_mat_get_method2( hecMAT )
326 integer(kind=kint) :: hecmw_mat_get_method2
327 type(hecmwst_matrix) :: hecmat
328
329 hecmw_mat_get_method2 = hecmat%Iarray(idx_i_method2)
330 end function hecmw_mat_get_method2
331
332 subroutine hecmw_mat_set_precond( hecMAT, precond )
333 type(hecmwst_matrix) :: hecmat
334 integer(kind=kint) :: precond
335
336 hecmat%Iarray(idx_i_precond) = precond
337 end subroutine hecmw_mat_set_precond
338
339 function hecmw_mat_get_precond( hecMAT )
340 integer(kind=kint) :: hecmw_mat_get_precond
341 type(hecmwst_matrix) :: hecmat
342
343 hecmw_mat_get_precond = hecmat%Iarray(idx_i_precond)
344 end function hecmw_mat_get_precond
345
346 subroutine hecmw_mat_set_nset( hecMAT, nset )
347 type(hecmwst_matrix) :: hecmat
348 integer(kind=kint) :: nset
349
350 hecmat%Iarray(idx_i_nset) = nset
351 end subroutine hecmw_mat_set_nset
352
353 function hecmw_mat_get_nset( hecMAT )
354 integer(kind=kint) :: hecmw_mat_get_nset
355 type(hecmwst_matrix) :: hecmat
356
357 hecmw_mat_get_nset = hecmat%Iarray(idx_i_nset)
358 end function hecmw_mat_get_nset
359
360 subroutine hecmw_mat_set_iterpremax( hecMAT, iterpremax )
361 type(hecmwst_matrix) :: hecmat
362 integer(kind=kint) :: iterpremax
363
364 if (iterpremax.lt.0) iterpremax= 0
365 if (iterpremax.gt.4) iterpremax= 4
366
367 hecmat%Iarray(idx_i_iterpremax) = iterpremax
368 end subroutine hecmw_mat_set_iterpremax
369
370 function hecmw_mat_get_iterpremax( hecMAT )
371 integer(kind=kint) :: hecmw_mat_get_iterpremax
372 type(hecmwst_matrix) :: hecmat
373
374 hecmw_mat_get_iterpremax = hecmat%Iarray(idx_i_iterpremax)
375 end function hecmw_mat_get_iterpremax
376
377 subroutine hecmw_mat_set_nrest( hecMAT, nrest )
378 type(hecmwst_matrix) :: hecmat
379 integer(kind=kint) :: nrest
380
381 hecmat%Iarray(idx_i_nrest) = nrest
382 end subroutine hecmw_mat_set_nrest
383
384 function hecmw_mat_get_nrest( hecMAT )
385 integer(kind=kint) :: hecmw_mat_get_nrest
386 type(hecmwst_matrix) :: hecmat
387
388 hecmw_mat_get_nrest = hecmat%Iarray(idx_i_nrest)
389 end function hecmw_mat_get_nrest
390
391 subroutine hecmw_mat_set_scaling( hecMAT, scaling )
392 type(hecmwst_matrix) :: hecmat
393 integer(kind=kint) :: scaling
394
395 hecmat%Iarray(idx_i_scaling) = scaling
396 end subroutine hecmw_mat_set_scaling
397
398 function hecmw_mat_get_scaling( hecMAT )
399 integer(kind=kint) :: hecmw_mat_get_scaling
400 type(hecmwst_matrix) :: hecmat
401
402 hecmw_mat_get_scaling = hecmat%Iarray(idx_i_scaling)
403 end function hecmw_mat_get_scaling
404
405 subroutine hecmw_mat_set_penalized( hecMAT, penalized )
406 type(hecmwst_matrix) :: hecmat
407 integer(kind=kint) :: penalized
408
409 hecmat%Iarray(idx_i_penalized) = penalized
410 end subroutine hecmw_mat_set_penalized
411
412 function hecmw_mat_get_penalized( hecMAT )
413 integer(kind=kint) :: hecmw_mat_get_penalized
414 type(hecmwst_matrix) :: hecmat
415
416 hecmw_mat_get_penalized = hecmat%Iarray(idx_i_penalized)
417 end function hecmw_mat_get_penalized
418
419 subroutine hecmw_mat_set_penalized_b( hecMAT, penalized_b )
420 type(hecmwst_matrix) :: hecmat
421 integer(kind=kint) :: penalized_b
422
423 hecmat%Iarray(idx_i_penalized_b) = penalized_b
424 end subroutine hecmw_mat_set_penalized_b
425
426 function hecmw_mat_get_penalized_b( hecMAT )
427 integer(kind=kint) :: hecmw_mat_get_penalized_b
428 type(hecmwst_matrix) :: hecmat
429
430 hecmw_mat_get_penalized_b = hecmat%Iarray(idx_i_penalized_b)
431 end function hecmw_mat_get_penalized_b
432
433 subroutine hecmw_mat_set_mpc_method( hecMAT, mpc_method )
434 type(hecmwst_matrix) :: hecmat
435 integer(kind=kint) :: mpc_method
436
437 hecmat%Iarray(idx_i_mpc_method) = mpc_method
438 end subroutine hecmw_mat_set_mpc_method
439
440 function hecmw_mat_get_mpc_method( hecMAT )
441 integer(kind=kint) :: hecmw_mat_get_mpc_method
442 type(hecmwst_matrix) :: hecmat
443
444 hecmw_mat_get_mpc_method = hecmat%Iarray(idx_i_mpc_method)
445 end function hecmw_mat_get_mpc_method
446
447 function hecmw_mat_get_estcond( hecMAT )
448 integer(kind=kint) :: hecmw_mat_get_estcond
449 type(hecmwst_matrix) :: hecmat
450 hecmw_mat_get_estcond = hecmat%Iarray(idx_i_estcond)
451 end function hecmw_mat_get_estcond
452
453 subroutine hecmw_mat_set_estcond( hecMAT, estcond )
454 type(hecmwst_matrix) :: hecmat
455 integer(kind=kint) :: estcond
456 hecmat%Iarray(idx_i_estcond) = estcond
457 end subroutine hecmw_mat_set_estcond
458
459 subroutine hecmw_mat_set_iterlog( hecMAT, iterlog )
460 type(hecmwst_matrix) :: hecmat
461 integer(kind=kint) :: iterlog
462
463 hecmat%Iarray(idx_i_iterlog) = iterlog
464 end subroutine hecmw_mat_set_iterlog
465
466 function hecmw_mat_get_iterlog( hecMAT )
467 integer(kind=kint) :: hecmw_mat_get_iterlog
468 type(hecmwst_matrix) :: hecmat
469
470 hecmw_mat_get_iterlog = hecmat%Iarray(idx_i_iterlog)
471 end function hecmw_mat_get_iterlog
472
473 subroutine hecmw_mat_set_timelog( hecMAT, timelog )
474 type(hecmwst_matrix) :: hecmat
475 integer(kind=kint) :: timelog
476
477 hecmat%Iarray(idx_i_timelog) = timelog
478 end subroutine hecmw_mat_set_timelog
479
480 function hecmw_mat_get_timelog( hecMAT )
481 integer(kind=kint) :: hecmw_mat_get_timelog
482 type(hecmwst_matrix) :: hecmat
483
484 hecmw_mat_get_timelog = hecmat%Iarray(idx_i_timelog)
485 end function hecmw_mat_get_timelog
486
487 function hecmw_mat_get_dump( hecMAT )
488 integer(kind=kint) :: hecmw_mat_get_dump
489 type(hecmwst_matrix) :: hecmat
490 hecmw_mat_get_dump = hecmat%Iarray(idx_i_dump)
491 end function hecmw_mat_get_dump
492
493 subroutine hecmw_mat_set_dump( hecMAT, dump_type )
494 type(hecmwst_matrix) :: hecmat
495 integer(kind=kint) :: dump_type
496 hecmat%Iarray(idx_i_dump) = dump_type
497 end subroutine hecmw_mat_set_dump
498
499 function hecmw_mat_get_dump_exit( hecMAT )
500 integer(kind=kint) :: hecmw_mat_get_dump_exit
501 type(hecmwst_matrix) :: hecmat
502 hecmw_mat_get_dump_exit = hecmat%Iarray(idx_i_dump_exit)
503 end function hecmw_mat_get_dump_exit
504
505 subroutine hecmw_mat_set_dump_exit( hecMAT, dump_exit )
506 type(hecmwst_matrix) :: hecmat
507 integer(kind=kint) :: dump_exit
508 hecmat%Iarray(idx_i_dump_exit) = dump_exit
509 end subroutine hecmw_mat_set_dump_exit
510
511 function hecmw_mat_get_usejad( hecMAT )
512 integer(kind=kint) :: hecmw_mat_get_usejad
513 type(hecmwst_matrix) :: hecmat
514 hecmw_mat_get_usejad = hecmat%Iarray(idx_i_usejad)
515 end function hecmw_mat_get_usejad
516
517 subroutine hecmw_mat_set_usejad( hecMAT, usejad )
518 type(hecmwst_matrix) :: hecmat
519 integer(kind=kint) :: usejad
520 hecmat%Iarray(idx_i_usejad) = usejad
521 end subroutine hecmw_mat_set_usejad
522
523 function hecmw_mat_get_ncolor_in( hecMAT )
524 integer(kind=kint) :: hecmw_mat_get_ncolor_in
525 type(hecmwst_matrix) :: hecmat
526 hecmw_mat_get_ncolor_in = hecmat%Iarray(idx_i_ncolor_in)
527 end function hecmw_mat_get_ncolor_in
528
529 subroutine hecmw_mat_set_ncolor_in( hecMAT, ncolor_in )
530 type(hecmwst_matrix) :: hecmat
531 integer(kind=kint) :: ncolor_in
532 hecmat%Iarray(idx_i_ncolor_in) = ncolor_in
533 end subroutine hecmw_mat_set_ncolor_in
534
536 integer(kind=kint) :: hecmw_mat_get_maxrecycle_precond
537 type(hecmwst_matrix) :: hecmat
538 hecmw_mat_get_maxrecycle_precond = hecmat%Iarray(idx_i_maxrecycle_precond)
540
541 subroutine hecmw_mat_set_maxrecycle_precond( hecMAT, maxrecycle_precond )
542 type(hecmwst_matrix) :: hecmat
543 integer(kind=kint) :: maxrecycle_precond
544 if (maxrecycle_precond > 100) maxrecycle_precond = 100
545 hecmat%Iarray(idx_i_maxrecycle_precond) = maxrecycle_precond
547
549 integer(kind=kint) :: hecmw_mat_get_nrecycle_precond
550 type(hecmwst_matrix) :: hecmat
551 hecmw_mat_get_nrecycle_precond = hecmat%Iarray(idx_i_nrecycle_precond)
553
555 type(hecmwst_matrix) :: hecmat
556 hecmat%Iarray(idx_i_nrecycle_precond) = 0
558
560 type(hecmwst_matrix) :: hecmat
561 hecmat%Iarray(idx_i_nrecycle_precond) = hecmat%Iarray(idx_i_nrecycle_precond) + 1
563
564 function hecmw_mat_get_flag_numfact( hecMAT )
565 integer(kind=kint) :: hecmw_mat_get_flag_numfact
566 type(hecmwst_matrix) :: hecmat
567 hecmw_mat_get_flag_numfact = hecmat%Iarray(idx_i_flag_numfact)
568 end function hecmw_mat_get_flag_numfact
569
570 subroutine hecmw_mat_set_flag_numfact( hecMAT, flag_numfact )
571 type(hecmwst_matrix) :: hecmat
572 integer(kind=kint) :: flag_numfact
573 hecmat%Iarray(idx_i_flag_numfact) = flag_numfact
574 end subroutine hecmw_mat_set_flag_numfact
575
577 integer(kind=kint) :: hecmw_mat_get_flag_symbfact
578 type(hecmwst_matrix) :: hecmat
579 hecmw_mat_get_flag_symbfact = hecmat%Iarray(idx_i_flag_symbfact)
580 end function hecmw_mat_get_flag_symbfact
581
582 subroutine hecmw_mat_set_flag_symbfact( hecMAT, flag_symbfact )
583 type(hecmwst_matrix) :: hecmat
584 integer(kind=kint) :: flag_symbfact
585 hecmat%Iarray(idx_i_flag_symbfact) = flag_symbfact
586 end subroutine hecmw_mat_set_flag_symbfact
587
588 subroutine hecmw_mat_clear_flag_symbfact( hecMAT )
589 type(hecmwst_matrix) :: hecmat
590 hecmat%Iarray(idx_i_flag_symbfact) = 0
591 end subroutine hecmw_mat_clear_flag_symbfact
592
593 function hecmw_mat_get_solver_type( hecMAT )
594 integer(kind=kint) :: hecmw_mat_get_solver_type
595 type(hecmwst_matrix) :: hecmat
596 hecmw_mat_get_solver_type = hecmat%Iarray(idx_i_solver_type)
597 end function hecmw_mat_get_solver_type
598
599 subroutine hecmw_mat_set_solver_type( hecMAT, solver_type )
600 type(hecmwst_matrix) :: hecmat
601 integer(kind=kint) :: solver_type
602 hecmat%Iarray(idx_i_solver_type) = solver_type
603 end subroutine hecmw_mat_set_solver_type
604
605 subroutine hecmw_mat_set_flag_converged( hecMAT, flag_converged )
606 type(hecmwst_matrix) :: hecmat
607 integer(kind=kint) :: flag_converged
608 hecmat%Iarray(idx_i_flag_converged) = flag_converged
609 end subroutine hecmw_mat_set_flag_converged
610
612 integer(kind=kint) :: hecmw_mat_get_flag_converged
613 type(hecmwst_matrix) :: hecmat
614 hecmw_mat_get_flag_converged = hecmat%Iarray(idx_i_flag_converged)
616
617 subroutine hecmw_mat_set_flag_diverged( hecMAT, flag_diverged )
618 type(hecmwst_matrix) :: hecmat
619 integer(kind=kint) :: flag_diverged
620 hecmat%Iarray(idx_i_flag_diverged) = flag_diverged
621 end subroutine hecmw_mat_set_flag_diverged
622
624 integer(kind=kint) :: hecmw_mat_get_flag_diverged
625 type(hecmwst_matrix) :: hecmat
626 hecmw_mat_get_flag_diverged = hecmat%Iarray(idx_i_flag_diverged)
627 end function hecmw_mat_get_flag_diverged
628
629 subroutine hecmw_mat_set_flag_mpcmatvec( hecMAT, flag_mpcmatvec )
630 type(hecmwst_matrix) :: hecmat
631 integer(kind=kint) :: flag_mpcmatvec
632 hecmat%Iarray(idx_i_flag_mpcmatvec) = flag_mpcmatvec
633 end subroutine hecmw_mat_set_flag_mpcmatvec
634
636 integer(kind=kint) :: hecmw_mat_get_flag_mpcmatvec
637 type(hecmwst_matrix) :: hecmat
638 hecmw_mat_get_flag_mpcmatvec = hecmat%Iarray(idx_i_flag_mpcmatvec)
640
641 subroutine hecmw_mat_set_solver_opt1( hecMAT, solver_opt1 )
642 type(hecmwst_matrix) :: hecmat
643 integer(kind=kint) :: solver_opt1
644 hecmat%Iarray(idx_i_solver_opt1) = solver_opt1
645 end subroutine hecmw_mat_set_solver_opt1
646
647 function hecmw_mat_get_solver_opt1( hecMAT )
648 integer(kind=kint) :: hecmw_mat_get_solver_opt1
649 type(hecmwst_matrix) :: hecmat
650 hecmw_mat_get_solver_opt1 = hecmat%Iarray(idx_i_solver_opt1)
651 end function hecmw_mat_get_solver_opt1
652
653 subroutine hecmw_mat_set_solver_opt2( hecMAT, solver_opt2 )
654 type(hecmwst_matrix) :: hecmat
655 integer(kind=kint) :: solver_opt2
656 hecmat%Iarray(idx_i_solver_opt2) = solver_opt2
657 end subroutine hecmw_mat_set_solver_opt2
658
659 function hecmw_mat_get_solver_opt2( hecMAT )
660 integer(kind=kint) :: hecmw_mat_get_solver_opt2
661 type(hecmwst_matrix) :: hecmat
662 hecmw_mat_get_solver_opt2 = hecmat%Iarray(idx_i_solver_opt2)
663 end function hecmw_mat_get_solver_opt2
664
665 subroutine hecmw_mat_set_solver_opt3( hecMAT, solver_opt3 )
666 type(hecmwst_matrix) :: hecmat
667 integer(kind=kint) :: solver_opt3
668 hecmat%Iarray(idx_i_solver_opt3) = solver_opt3
669 end subroutine hecmw_mat_set_solver_opt3
670
671 function hecmw_mat_get_solver_opt3( hecMAT )
672 integer(kind=kint) :: hecmw_mat_get_solver_opt3
673 type(hecmwst_matrix) :: hecmat
674 hecmw_mat_get_solver_opt3 = hecmat%Iarray(idx_i_solver_opt3)
675 end function hecmw_mat_get_solver_opt3
676
677 subroutine hecmw_mat_set_solver_opt4( hecMAT, solver_opt4 )
678 type(hecmwst_matrix) :: hecmat
679 integer(kind=kint) :: solver_opt4
680 hecmat%Iarray(idx_i_solver_opt4) = solver_opt4
681 end subroutine hecmw_mat_set_solver_opt4
682
683 function hecmw_mat_get_solver_opt4( hecMAT )
684 integer(kind=kint) :: hecmw_mat_get_solver_opt4
685 type(hecmwst_matrix) :: hecmat
686 hecmw_mat_get_solver_opt4 = hecmat%Iarray(idx_i_solver_opt4)
687 end function hecmw_mat_get_solver_opt4
688
689 subroutine hecmw_mat_set_solver_opt5( hecMAT, solver_opt5 )
690 type(hecmwst_matrix) :: hecmat
691 integer(kind=kint) :: solver_opt5
692 hecmat%Iarray(idx_i_solver_opt5) = solver_opt5
693 end subroutine hecmw_mat_set_solver_opt5
694
695 function hecmw_mat_get_solver_opt5( hecMAT )
696 integer(kind=kint) :: hecmw_mat_get_solver_opt5
697 type(hecmwst_matrix) :: hecmat
698 hecmw_mat_get_solver_opt5 = hecmat%Iarray(idx_i_solver_opt5)
699 end function hecmw_mat_get_solver_opt5
700
701 subroutine hecmw_mat_set_solver_opt6( hecMAT, solver_opt6 )
702 type(hecmwst_matrix) :: hecmat
703 integer(kind=kint) :: solver_opt6
704 hecmat%Iarray(idx_i_solver_opt6) = solver_opt6
705 end subroutine hecmw_mat_set_solver_opt6
706
707 function hecmw_mat_get_solver_opt6( hecMAT )
708 integer(kind=kint) :: hecmw_mat_get_solver_opt6
709 type(hecmwst_matrix) :: hecmat
710 hecmw_mat_get_solver_opt6 = hecmat%Iarray(idx_i_solver_opt6)
711 end function hecmw_mat_get_solver_opt6
712
713 subroutine hecmw_mat_set_resid( hecMAT, resid )
714 type(hecmwst_matrix) :: hecmat
715 real(kind=kreal) :: resid
716
717 hecmat%Rarray(idx_r_resid) = resid
718 end subroutine hecmw_mat_set_resid
719
720 function hecmw_mat_get_resid( hecMAT )
721 real(kind=kreal) :: hecmw_mat_get_resid
722 type(hecmwst_matrix) :: hecmat
723
724 hecmw_mat_get_resid = hecmat%Rarray(idx_r_resid)
725 end function hecmw_mat_get_resid
726
727 subroutine hecmw_mat_set_sigma_diag( hecMAT, sigma_diag )
728 type(hecmwst_matrix) :: hecmat
729 real(kind=kreal) :: sigma_diag
730
731 if( sigma_diag < 0.d0 ) then
732 hecmat%Rarray(idx_r_sigma_diag) = -1.d0
733 elseif( sigma_diag < 1.d0 ) then
734 hecmat%Rarray(idx_r_sigma_diag) = 1.d0
735 elseif( sigma_diag > 2.d0 ) then
736 hecmat%Rarray(idx_r_sigma_diag) = 2.d0
737 else
738 hecmat%Rarray(idx_r_sigma_diag) = sigma_diag
739 endif
740 end subroutine hecmw_mat_set_sigma_diag
741
742 function hecmw_mat_get_sigma_diag( hecMAT )
743 real(kind=kreal) :: hecmw_mat_get_sigma_diag
744 type(hecmwst_matrix) :: hecmat
745
746 hecmw_mat_get_sigma_diag = hecmat%Rarray(idx_r_sigma_diag)
747 end function hecmw_mat_get_sigma_diag
748
749 subroutine hecmw_mat_set_sigma( hecMAT, sigma )
750 type(hecmwst_matrix) :: hecmat
751 real(kind=kreal) :: sigma
752
753 if (sigma < 0.d0) then
754 hecmat%Rarray(idx_r_sigma) = 0.d0
755 elseif (sigma > 1.d0) then
756 hecmat%Rarray(idx_r_sigma) = 1.d0
757 else
758 hecmat%Rarray(idx_r_sigma) = sigma
759 endif
760 end subroutine hecmw_mat_set_sigma
761
762 function hecmw_mat_get_sigma( hecMAT )
763 real(kind=kreal) :: hecmw_mat_get_sigma
764 type(hecmwst_matrix) :: hecmat
765
766 hecmw_mat_get_sigma = hecmat%Rarray(idx_r_sigma)
767 end function hecmw_mat_get_sigma
768
769 subroutine hecmw_mat_set_thresh( hecMAT, thresh )
770 type(hecmwst_matrix) :: hecmat
771 real(kind=kreal) :: thresh
772
773 hecmat%Rarray(idx_r_thresh) = thresh
774 end subroutine hecmw_mat_set_thresh
775
776 function hecmw_mat_get_thresh( hecMAT )
777 real(kind=kreal) :: hecmw_mat_get_thresh
778 type(hecmwst_matrix) :: hecmat
779
780 hecmw_mat_get_thresh = hecmat%Rarray(idx_r_thresh)
781 end function hecmw_mat_get_thresh
782
783 subroutine hecmw_mat_set_filter( hecMAT, filter )
784 type(hecmwst_matrix) :: hecmat
785 real(kind=kreal) :: filter
786
787 hecmat%Rarray(idx_r_filter) = filter
788 end subroutine hecmw_mat_set_filter
789
790 function hecmw_mat_get_filter( hecMAT )
791 real(kind=kreal) :: hecmw_mat_get_filter
792 type(hecmwst_matrix) :: hecmat
793
794 hecmw_mat_get_filter = hecmat%Rarray(idx_r_filter)
795 end function hecmw_mat_get_filter
796
797 subroutine hecmw_mat_set_penalty( hecMAT, penalty )
798 type(hecmwst_matrix) :: hecmat
799 real(kind=kreal) :: penalty
800
801 hecmat%Rarray(idx_r_penalty) = penalty
802 end subroutine hecmw_mat_set_penalty
803
804 function hecmw_mat_get_penalty( hecMAT )
805 real(kind=kreal) :: hecmw_mat_get_penalty
806 type(hecmwst_matrix) :: hecmat
807
808 hecmw_mat_get_penalty = hecmat%Rarray(idx_r_penalty)
809 end function hecmw_mat_get_penalty
810
811 subroutine hecmw_mat_set_penalty_alpha( hecMAT, alpha )
812 type(hecmwst_matrix) :: hecmat
813 real(kind=kreal) :: alpha
814
815 hecmat%Rarray(idx_r_penalty_alpha) = alpha
816 end subroutine hecmw_mat_set_penalty_alpha
817
820 type(hecmwst_matrix) :: hecmat
821
822 hecmw_mat_get_penalty_alpha = hecmat%Rarray(idx_r_penalty_alpha)
823 end function hecmw_mat_get_penalty_alpha
824
825 function hecmw_mat_diag_max(hecMAT, hecMESH)
826 real(kind=kreal) :: hecmw_mat_diag_max
827 type (hecmwst_matrix) :: hecmat
828 type (hecmwst_local_mesh) :: hecmesh
829 integer(kind=kint) :: ndiag, i
830
831 hecmw_mat_diag_max = -1.0e20
832 ndiag = hecmat%NDOF**2 * hecmat%NP
833 do i = 1, ndiag
834 if( hecmat%D(i) > hecmw_mat_diag_max ) hecmw_mat_diag_max = hecmat%D(i)
835 enddo
837 end function hecmw_mat_diag_max
838
840 type (hecmwst_matrix) :: hecmat
841 integer(kind=kint) :: nrecycle, maxrecycle
842 if (hecmat%Iarray(idx_i_flag_symbfact) >= 1) then
843 hecmat%Iarray(idx_i_flag_numfact)=1
845 elseif (hecmat%Iarray(idx_i_flag_numfact) > 1) then
847 hecmat%Iarray(idx_i_flag_numfact) = 1
848 elseif (hecmat%Iarray(idx_i_flag_numfact) == 1) then
849 nrecycle = hecmw_mat_get_nrecycle_precond(hecmat)
850 maxrecycle = hecmw_mat_get_maxrecycle_precond(hecmat)
851 if ( nrecycle < maxrecycle ) then
852 hecmat%Iarray(idx_i_flag_numfact) = 0
854 else
856 endif
857 endif
859
860 subroutine hecmw_mat_substitute( dest, src )
861 type (hecmwst_matrix), intent(inout) :: dest
862 type (hecmwst_matrix), intent(inout) :: src
863 dest%N = src%N
864 dest%NP = src%NP
865 dest%NPL = src%NPL
866 dest%NPU = src%NPU
867 dest%NDOF = src%NDOF
868 dest%NPCL = src%NPCU
869 if (associated(src%D)) dest%D => src%D
870 if (associated(src%B)) dest%B => src%B
871 if (associated(src%X)) dest%X => src%X
872 if (associated(src%ALU)) dest%ALU => src%ALU
873 if (associated(src%AL)) dest%AL => src%AL
874 if (associated(src%AU)) dest%AU => src%AU
875 if (associated(src%CAL)) dest%CAL => src%CAL
876 if (associated(src%indexL)) dest%indexL => src%indexL
877 if (associated(src%indexU)) dest%indexU => src%indexU
878 if (associated(src%indexCL)) dest%indexCL => src%indexCL
879 if (associated(src%indexCU)) dest%indexCU => src%indexCU
880 if (associated(src%itemL)) dest%itemL => src%itemL
881 if (associated(src%itemU)) dest%itemU => src%itemU
882 if (associated(src%itemCL)) dest%itemCL => src%itemCL
883 if (associated(src%itemCU)) dest%itemCU => src%itemCU
884 dest%Iarray(:) = src%Iarray(:)
885 dest%Rarray(:) = src%Rarray(:)
886 call hecmw_cmat_substitute( dest%cmat, src%cmat )
887 end subroutine hecmw_mat_substitute
888
889end module hecmw_matrix_misc
subroutine, public hecmw_cmat_substitute(dest, src)
subroutine, public hecmw_cmat_init(cmat)
subroutine, public hecmw_cmat_finalize(cmat)
subroutine, public hecmw_cmat_clear(cmat)
integer(kind=kint) function, public hecmw_mat_get_iterpremax(hecmat)
integer(kind=kint) function, public hecmw_mat_get_usejad(hecmat)
integer(kind=kint) function, public hecmw_mat_get_nrest(hecmat)
subroutine, public hecmw_mat_incr_nrecycle_precond(hecmat)
subroutine, public hecmw_mat_set_resid(hecmat, resid)
integer(kind=kint) function, public hecmw_mat_get_maxrecycle_precond(hecmat)
subroutine, public hecmw_mat_set_usejad(hecmat, usejad)
integer(kind=kint) function, public hecmw_mat_get_method2(hecmat)
integer(kind=kint) function, public hecmw_mat_get_solver_opt6(hecmat)
integer(kind=kint) function, public hecmw_mat_get_solver_opt4(hecmat)
subroutine, public hecmw_mat_clear_flag_symbfact(hecmat)
integer(kind=kint) function, public hecmw_mat_get_method(hecmat)
subroutine, public hecmw_mat_set_sigma_diag(hecmat, sigma_diag)
integer(kind=kint) function, public hecmw_mat_get_solver_opt2(hecmat)
integer(kind=kint) function, public hecmw_mat_get_flag_symbfact(hecmat)
subroutine, public hecmw_mat_recycle_precond_setting(hecmat)
integer(kind=kint) function, public hecmw_mat_get_flag_mpcmatvec(hecmat)
subroutine, public hecmw_mat_set_scaling(hecmat, scaling)
subroutine, public hecmw_mat_set_flag_numfact(hecmat, flag_numfact)
integer(kind=kint) function, public hecmw_mat_get_solver_type(hecmat)
real(kind=kreal) function, public hecmw_mat_get_penalty(hecmat)
subroutine, public hecmw_mat_set_solver_opt6(hecmat, solver_opt6)
subroutine, public hecmw_mat_set_filter(hecmat, filter)
integer(kind=kint) function, public hecmw_mat_get_flag_diverged(hecmat)
subroutine, public hecmw_mat_set_penalized(hecmat, penalized)
subroutine, public hecmw_mat_set_penalized_b(hecmat, penalized_b)
integer(kind=kint) function, public hecmw_mat_get_nrecycle_precond(hecmat)
subroutine, public hecmw_mat_set_dump(hecmat, dump_type)
subroutine, public hecmw_mat_set_solver_opt1(hecmat, solver_opt1)
subroutine, public hecmw_mat_set_solver_type(hecmat, solver_type)
subroutine, public hecmw_mat_set_solver_opt2(hecmat, solver_opt2)
integer(kind=kint) function, public hecmw_mat_get_ncolor_in(hecmat)
subroutine, public hecmw_mat_set_penalty(hecmat, penalty)
subroutine, public hecmw_mat_reset_nrecycle_precond(hecmat)
integer(kind=kint) function, public hecmw_mat_get_timelog(hecmat)
subroutine, public hecmw_mat_clear(hecmat)
subroutine, public hecmw_mat_set_estcond(hecmat, estcond)
integer(kind=kint) function, public hecmw_mat_get_estcond(hecmat)
subroutine, public hecmw_mat_set_ncolor_in(hecmat, ncolor_in)
subroutine, public hecmw_mat_set_iterlog(hecmat, iterlog)
real(kind=kreal) function, public hecmw_mat_get_resid(hecmat)
integer(kind=kint) function, public hecmw_mat_get_dump(hecmat)
integer(kind=kint) function, public hecmw_mat_get_penalized_b(hecmat)
subroutine, public hecmw_mat_set_sigma(hecmat, sigma)
subroutine, public hecmw_mat_set_mpc_method(hecmat, mpc_method)
subroutine, public hecmw_mat_set_method2(hecmat, method2)
subroutine, public hecmw_mat_set_solver_opt3(hecmat, solver_opt3)
integer(kind=kint) function, public hecmw_mat_get_scaling(hecmat)
subroutine, public hecmw_mat_set_flag_symbfact(hecmat, flag_symbfact)
subroutine, public hecmw_mat_substitute(dest, src)
subroutine, public hecmw_mat_copy_profile(hecmatorg, hecmat)
real(kind=kreal) function, public hecmw_mat_diag_max(hecmat, hecmesh)
subroutine, public hecmw_mat_set_flag_converged(hecmat, flag_converged)
subroutine, public hecmw_mat_set_iter(hecmat, iter)
subroutine, public hecmw_mat_set_dump_exit(hecmat, dump_exit)
subroutine, public hecmw_mat_set_solver_opt5(hecmat, solver_opt5)
subroutine, public hecmw_mat_set_nrest(hecmat, nrest)
subroutine, public hecmw_mat_set_nset(hecmat, nset)
subroutine, public hecmw_mat_set_method(hecmat, method)
integer(kind=kint) function, public hecmw_mat_get_iter(hecmat)
subroutine, public hecmw_mat_copy_val(hecmatorg, hecmat)
subroutine, public hecmw_mat_set_maxrecycle_precond(hecmat, maxrecycle_precond)
subroutine, public hecmw_mat_set_flag_mpcmatvec(hecmat, flag_mpcmatvec)
real(kind=kreal) function, public hecmw_mat_get_sigma(hecmat)
integer(kind=kint) function, public hecmw_mat_get_mpc_method(hecmat)
real(kind=kreal) function, public hecmw_mat_get_penalty_alpha(hecmat)
real(kind=kreal) function, public hecmw_mat_get_thresh(hecmat)
subroutine, public hecmw_mat_set_flag_diverged(hecmat, flag_diverged)
subroutine, public hecmw_mat_init(hecmat)
integer(kind=kint) function, public hecmw_mat_get_solver_opt3(hecmat)
subroutine, public hecmw_mat_finalize(hecmat)
integer(kind=kint) function, public hecmw_mat_get_penalized(hecmat)
integer(kind=kint) function, public hecmw_mat_get_solver_opt1(hecmat)
subroutine, public hecmw_mat_set_iterpremax(hecmat, iterpremax)
integer(kind=kint) function, public hecmw_mat_get_precond(hecmat)
subroutine, public hecmw_mat_clear_b(hecmat)
integer(kind=kint) function, public hecmw_mat_get_flag_numfact(hecmat)
integer(kind=kint) function, public hecmw_mat_get_flag_converged(hecmat)
subroutine, public hecmw_mat_set_penalty_alpha(hecmat, alpha)
integer(kind=kint) function, public hecmw_mat_get_nset(hecmat)
subroutine, public hecmw_mat_set_solver_opt4(hecmat, solver_opt4)
subroutine, public hecmw_mat_set_timelog(hecmat, timelog)
subroutine, public hecmw_mat_set_thresh(hecmat, thresh)
real(kind=kreal) function, public hecmw_mat_get_filter(hecmat)
integer(kind=kint) function, public hecmw_mat_get_dump_exit(hecmat)
integer(kind=kint) function, public hecmw_mat_get_iterlog(hecmat)
integer(kind=kint) function, public hecmw_mat_get_solver_opt5(hecmat)
real(kind=kreal) function, public hecmw_mat_get_sigma_diag(hecmat)
subroutine, public hecmw_mat_set_precond(hecmat, precond)
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=kint), parameter hecmw_max
integer(kind=4), parameter kreal
subroutine hecmw_nullify_matrix(p)
subroutine hecmw_allreduce_r1(hecmesh, s, ntag)