1!------------------------------------------------------------------------------- 2! Copyright (c) 2019 FrontISTR Commons 3! This software is released under the MIT License, see LICENSE.txt 4!------------------------------------------------------------------------------- 5 6module hecmw_matrix_misc 7 use hecmw_util 8 use hecmw_matrix_contact 9 use m_hecmw_comm_f 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 17 public :: hecmw_mat_copy_profile 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 28 public :: hecmw_mat_set_iterpremax 29 public :: hecmw_mat_get_iterpremax 30 public :: hecmw_mat_set_nrest 31 public :: hecmw_mat_get_nrest 32 public :: hecmw_mat_set_scaling 33 public :: hecmw_mat_get_scaling 34 public :: hecmw_mat_set_penalized 35 public :: hecmw_mat_get_penalized 36 public :: hecmw_mat_set_penalized_b 37 public :: hecmw_mat_get_penalized_b 38 public :: hecmw_mat_set_mpc_method 39 public :: hecmw_mat_get_mpc_method 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 48 public :: hecmw_mat_set_dump_exit 49 public :: hecmw_mat_get_dump_exit 50 public :: hecmw_mat_set_usejad 51 public :: hecmw_mat_get_usejad 52 public :: hecmw_mat_set_ncolor_in 53 public :: hecmw_mat_get_ncolor_in 54 public :: hecmw_mat_set_maxrecycle_precond 55 public :: hecmw_mat_get_maxrecycle_precond 56 public :: hecmw_mat_get_nrecycle_precond 57 public :: hecmw_mat_reset_nrecycle_precond 58 public :: hecmw_mat_incr_nrecycle_precond 59 public :: hecmw_mat_set_flag_numfact 60 public :: hecmw_mat_get_flag_numfact 61 public :: hecmw_mat_set_flag_symbfact 62 public :: hecmw_mat_get_flag_symbfact 63 public :: hecmw_mat_clear_flag_symbfact 64 public :: hecmw_mat_set_solver_type 65 public :: hecmw_mat_get_solver_type 66 67 public :: hecmw_mat_set_method2 68 public :: hecmw_mat_get_method2 69 public :: hecmw_mat_set_flag_converged 70 public :: hecmw_mat_get_flag_converged 71 public :: hecmw_mat_set_flag_diverged 72 public :: hecmw_mat_get_flag_diverged 73 public :: hecmw_mat_set_flag_mpcmatvec 74 public :: hecmw_mat_get_flag_mpcmatvec 75 76 public :: hecmw_mat_set_solver_opt1 77 public :: hecmw_mat_get_solver_opt1 78 public :: hecmw_mat_set_solver_opt2 79 public :: hecmw_mat_get_solver_opt2 80 public :: hecmw_mat_set_solver_opt3 81 public :: hecmw_mat_get_solver_opt3 82 public :: hecmw_mat_set_solver_opt4 83 public :: hecmw_mat_get_solver_opt4 84 public :: hecmw_mat_set_solver_opt5 85 public :: hecmw_mat_get_solver_opt5 86 public :: hecmw_mat_set_solver_opt6 87 public :: hecmw_mat_get_solver_opt6 88 89 public :: hecmw_mat_set_resid 90 public :: hecmw_mat_get_resid 91 public :: hecmw_mat_set_sigma_diag 92 public :: hecmw_mat_get_sigma_diag 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 101 public :: hecmw_mat_set_penalty_alpha 102 public :: hecmw_mat_get_penalty_alpha 103 104 public :: hecmw_mat_diag_max 105 public :: hecmw_mat_recycle_precond_setting 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 206 call hecmw_mat_reset_nrecycle_precond( hecMAT ) 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 535 function hecmw_mat_get_maxrecycle_precond( hecMAT ) 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) 539 end function hecmw_mat_get_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 546 end subroutine hecmw_mat_set_maxrecycle_precond 547 548 function hecmw_mat_get_nrecycle_precond( hecMAT ) 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) 552 end function hecmw_mat_get_nrecycle_precond 553 554 subroutine hecmw_mat_reset_nrecycle_precond( hecMAT ) 555 type(hecmwST_matrix) :: hecMAT 556 hecMAT%Iarray(IDX_I_NRECYCLE_PRECOND) = 0 557 end subroutine hecmw_mat_reset_nrecycle_precond 558 559 subroutine hecmw_mat_incr_nrecycle_precond( hecMAT ) 560 type(hecmwST_matrix) :: hecMAT 561 hecMAT%Iarray(IDX_I_NRECYCLE_PRECOND) = hecMAT%Iarray(IDX_I_NRECYCLE_PRECOND) + 1 562 end subroutine hecmw_mat_incr_nrecycle_precond 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 576 function hecmw_mat_get_flag_symbfact( hecMAT ) 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 611 function hecmw_mat_get_flag_converged( hecMAT ) 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) 615 end function hecmw_mat_get_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 623 function hecmw_mat_get_flag_diverged( hecMAT ) 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 635 function hecmw_mat_get_flag_mpcmatvec( hecMAT ) 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) 639 end function hecmw_mat_get_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 818 function hecmw_mat_get_penalty_alpha( hecMAT ) 819 real(kind=kreal) :: hecmw_mat_get_penalty_alpha 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 836 call hecmw_allREDUCE_R1(hecMESH, hecmw_mat_diag_max, hecmw_max) 837 end function hecmw_mat_diag_max 838 839 subroutine hecmw_mat_recycle_precond_setting( hecMAT ) 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 844 call hecmw_mat_reset_nrecycle_precond(hecMAT) 845 elseif (hecMAT%Iarray(IDX_I_FLAG_NUMFACT) > 1) then 846 call hecmw_mat_reset_nrecycle_precond(hecMAT) 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 853 call hecmw_mat_incr_nrecycle_precond(hecMAT) 854 else 855 call hecmw_mat_reset_nrecycle_precond(hecMAT) 856 endif 857 endif 858 end subroutine hecmw_mat_recycle_precond_setting 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 890