122 integer,
parameter :: IDX_I_ITER = 1
123 integer,
parameter :: IDX_I_METHOD = 2
124 integer,
parameter :: IDX_I_PRECOND = 3
125 integer,
parameter :: IDX_I_NSET = 4
126 integer,
parameter :: IDX_I_ITERPREMAX = 5
127 integer,
parameter :: IDX_I_NREST = 6
128 integer,
parameter :: IDX_I_NBFGS = 60
129 integer,
parameter :: IDX_I_SCALING = 7
130 integer,
parameter :: IDX_I_PENALIZED = 11
131 integer,
parameter :: IDX_I_PENALIZED_B = 12
132 integer,
parameter :: IDX_I_MPC_METHOD = 13
133 integer,
parameter :: IDX_I_ESTCOND = 14
134 integer,
parameter :: IDX_I_CONTACT_ELIM = 15
135 integer,
parameter :: IDX_I_RECOMPUTE_RESIDUAL = 16
136 integer,
parameter :: IDX_I_ITERLOG = 21
137 integer,
parameter :: IDX_I_TIMELOG = 22
138 integer,
parameter :: IDX_I_LOGLEVEL = 24
139 integer,
parameter :: IDX_I_DUMP = 31
140 integer,
parameter :: IDX_I_DUMP_EXIT = 32
141 integer,
parameter :: IDX_I_USEJAD = 33
142 integer,
parameter :: IDX_I_NCOLOR_IN = 34
143 integer,
parameter :: IDX_I_MAXRECYCLE_PRECOND = 35
144 integer,
parameter :: IDX_I_MATVEC_IMPL = 36
145 integer,
parameter :: IDX_I_PRECOND_IMPL = 37
146 integer,
parameter :: IDX_I_NRECYCLE_PRECOND = 96
147 integer,
parameter :: IDX_I_FLAG_NUMFACT = 97
148 integer,
parameter :: IDX_I_FLAG_SYMBFACT = 98
149 integer,
parameter :: IDX_I_SOLVER_TYPE = 99
151 integer,
parameter :: IDX_I_METHOD2 = 8
152 integer,
parameter :: IDX_I_FLAG_CONVERGED = 81
153 integer,
parameter :: IDX_I_FLAG_DIVERGED = 82
155 integer,
parameter :: IDX_I_SOLVER_OPT_S = 41
156 integer,
parameter :: IDX_I_SOLVER_OPT_E = 50
158 integer,
parameter :: IDX_R_RESID = 1
159 integer,
parameter :: IDX_R_SIGMA_DIAG = 2
160 integer,
parameter :: IDX_R_OMEGA = 3
161 integer,
parameter :: IDX_R_THRESH = 4
162 integer,
parameter :: IDX_R_FILTER = 5
163 integer,
parameter :: IDX_R_PENALTY = 11
164 integer,
parameter :: IDX_R_PENALTY_ALPHA = 12
166 integer,
parameter :: IDX_R_SOLVER_OPT_S = 41
167 integer,
parameter :: IDX_R_SOLVER_OPT_E = 50
185 #ifndef HECMW_ARCH_DEFAULT_MATVEC_IMPL
186 #define HECMW_ARCH_DEFAULT_MATVEC_IMPL HECMW_MATVEC_IMPL_BSR
188 #ifndef HECMW_ARCH_DEFAULT_PRECOND_IMPL
189 #define HECMW_ARCH_DEFAULT_PRECOND_IMPL HECMW_PRECOND_IMPL_BSR
261 if (
associated(hecmat%D))
deallocate(hecmat%D)
262 if (
associated(hecmat%B))
deallocate(hecmat%B)
263 if (
associated(hecmat%X))
deallocate(hecmat%X)
264 if (
associated(hecmat%AL))
deallocate(hecmat%AL)
265 if (
associated(hecmat%AU))
deallocate(hecmat%AU)
266 if (
associated(hecmat%indexL))
deallocate(hecmat%indexL)
267 if (
associated(hecmat%indexU))
deallocate(hecmat%indexU)
268 if (
associated(hecmat%itemL))
deallocate(hecmat%itemL)
269 if (
associated(hecmat%itemU))
deallocate(hecmat%itemU)
271 if (
associated(hecmat%A))
deallocate(hecmat%A)
272 if (
associated(hecmat%indexA))
deallocate(hecmat%indexA)
273 if (
associated(hecmat%itemA))
deallocate(hecmat%itemA)
280 hecmat%N = hecmatorg%N
281 hecmat%NP = hecmatorg%NP
282 hecmat%NDOF = hecmatorg%NDOF
283 hecmat%NPL = hecmatorg%NPL
284 hecmat%NPU = hecmatorg%NPU
285 allocate(hecmat%indexL(0:
size(hecmatorg%indexL)-1))
286 allocate(hecmat%indexU(0:
size(hecmatorg%indexU)-1))
287 allocate(hecmat%itemL (
size(hecmatorg%itemL )))
288 allocate(hecmat%itemU (
size(hecmatorg%itemU )))
289 allocate(hecmat%D (
size(hecmatorg%D )))
290 allocate(hecmat%AL(
size(hecmatorg%AL)))
291 allocate(hecmat%AU(
size(hecmatorg%AU)))
292 allocate(hecmat%B (
size(hecmatorg%B )))
293 allocate(hecmat%X (
size(hecmatorg%X )))
294 hecmat%indexL = hecmatorg%indexL
295 hecmat%indexU = hecmatorg%indexU
296 hecmat%itemL = hecmatorg%itemL
297 hecmat%itemU = hecmatorg%itemU
308 integer(kind=kint) :: ierr
309 integer(kind=kint) :: i
311 if (hecmat%N /= hecmatorg%N) ierr = 1
312 if (hecmat%NP /= hecmatorg%NP) ierr = 1
313 if (hecmat%NDOF /= hecmatorg%NDOF) ierr = 1
314 if (hecmat%NPL /= hecmatorg%NPL) ierr = 1
315 if (hecmat%NPU /= hecmatorg%NPU) ierr = 1
317 write(0,*)
'ERROR: hecmw_mat_copy_val: different profile'
320 do i = 1,
size(hecmat%D)
321 hecmat%D(i) = hecmatorg%D(i)
323 do i = 1,
size(hecmat%AL)
324 hecmat%AL(i) = hecmatorg%AL(i)
326 do i = 1,
size(hecmat%AU)
327 hecmat%AU(i) = hecmatorg%AU(i)
333 integer(kind=kint) :: iter
335 hecmat%Iarray(idx_i_iter) = iter
347 integer(kind=kint) :: method
349 hecmat%Iarray(idx_i_method) = method
361 integer(kind=kint) :: method2
363 hecmat%Iarray(idx_i_method2) = method2
375 integer(kind=kint) :: precond
377 hecmat%Iarray(idx_i_precond) = precond
389 integer(kind=kint) :: nset
391 hecmat%Iarray(idx_i_nset) = nset
403 integer(kind=kint) :: iterpremax
405 if (iterpremax.lt.0) iterpremax= 0
406 if (iterpremax.gt.4) iterpremax= 4
408 hecmat%Iarray(idx_i_iterpremax) = iterpremax
420 integer(kind=kint) :: nrest
422 hecmat%Iarray(idx_i_nrest) = nrest
434 integer(kind=kint) :: nbfgs
436 hecmat%Iarray(idx_i_nbfgs) = nbfgs
448 integer(kind=kint) :: scaling
450 hecmat%Iarray(idx_i_scaling) = scaling
462 integer(kind=kint) :: penalized
464 hecmat%Iarray(idx_i_penalized) = penalized
476 integer(kind=kint) :: penalized_b
478 hecmat%Iarray(idx_i_penalized_b) = penalized_b
490 integer(kind=kint) :: mpc_method
492 hecmat%Iarray(idx_i_mpc_method) = mpc_method
510 integer(kind=kint) :: estcond
511 hecmat%Iarray(idx_i_estcond) = estcond
522 integer(kind=kint) :: recompute_residual
523 hecmat%Iarray(idx_i_recompute_residual) = recompute_residual
534 integer(kind=kint) :: contact_elim
535 hecmat%Iarray(idx_i_contact_elim) = contact_elim
540 integer(kind=kint) :: iterlog
542 hecmat%Iarray(idx_i_iterlog) = iterlog
554 integer(kind=kint) :: timelog
556 hecmat%Iarray(idx_i_timelog) = timelog
571 integer(kind=kint) :: loglevel
573 hecmat%Iarray(idx_i_loglevel) = loglevel
591 integer(kind=kint) :: dump_type
592 hecmat%Iarray(idx_i_dump) = dump_type
603 integer(kind=kint) :: dump_exit
604 hecmat%Iarray(idx_i_dump_exit) = dump_exit
615 integer(kind=kint) :: usejad
616 hecmat%Iarray(idx_i_usejad) = usejad
627 integer(kind=kint) :: matvec_impl
628 hecmat%Iarray(idx_i_matvec_impl) = matvec_impl
639 integer(kind=kint) :: precond_impl
640 hecmat%Iarray(idx_i_precond_impl) = precond_impl
651 integer(kind=kint) :: ncolor_in
652 hecmat%Iarray(idx_i_ncolor_in) = ncolor_in
663 integer(kind=kint) :: maxrecycle_precond
664 if (maxrecycle_precond > 100) maxrecycle_precond = 100
665 hecmat%Iarray(idx_i_maxrecycle_precond) = maxrecycle_precond
676 hecmat%Iarray(idx_i_nrecycle_precond) = 0
681 hecmat%Iarray(idx_i_nrecycle_precond) = hecmat%Iarray(idx_i_nrecycle_precond) + 1
692 integer(kind=kint) :: flag_numfact
693 hecmat%Iarray(idx_i_flag_numfact) = flag_numfact
704 integer(kind=kint) :: flag_symbfact
705 hecmat%Iarray(idx_i_flag_symbfact) = flag_symbfact
710 hecmat%Iarray(idx_i_flag_symbfact) = 0
721 integer(kind=kint) :: solver_type
722 hecmat%Iarray(idx_i_solver_type) = solver_type
727 integer(kind=kint) :: flag_converged
728 hecmat%Iarray(idx_i_flag_converged) = flag_converged
739 integer(kind=kint) :: flag_diverged
740 hecmat%Iarray(idx_i_flag_diverged) = flag_diverged
751 integer(kind=kint) :: solver_opt(:)
752 integer(kind=kint) :: nopt
753 nopt = idx_i_solver_opt_e - idx_i_solver_opt_s + 1
754 hecmat%Iarray(idx_i_solver_opt_s:idx_i_solver_opt_e) = solver_opt(1:nopt)
759 integer(kind=kint) :: solver_opt(:)
760 integer(kind=kint) :: nopt
761 nopt = idx_i_solver_opt_e - idx_i_solver_opt_s + 1
762 solver_opt(1:nopt) = hecmat%Iarray(idx_i_solver_opt_s:idx_i_solver_opt_e)
767 real(kind=
kreal) :: solver_ropt(:)
768 integer(kind=kint) :: nopt
769 nopt = idx_r_solver_opt_e - idx_r_solver_opt_s + 1
770 hecmat%Rarray(idx_r_solver_opt_s:idx_r_solver_opt_e) = solver_ropt(1:nopt)
775 real(kind=
kreal) :: solver_ropt(:)
776 integer(kind=kint) :: nopt
777 nopt = idx_r_solver_opt_e - idx_r_solver_opt_s + 1
778 solver_ropt(1:nopt) = hecmat%Rarray(idx_r_solver_opt_s:idx_r_solver_opt_e)
783 real(kind=
kreal) :: resid
785 hecmat%Rarray(idx_r_resid) = resid
797 real(kind=
kreal) :: sigma_diag
799 if( sigma_diag < 0.d0 )
then
800 hecmat%Rarray(idx_r_sigma_diag) = -1.d0
801 elseif( sigma_diag < 1.d0 )
then
802 hecmat%Rarray(idx_r_sigma_diag) = 1.d0
803 elseif( sigma_diag > 2.d0 )
then
804 hecmat%Rarray(idx_r_sigma_diag) = 2.d0
806 hecmat%Rarray(idx_r_sigma_diag) = sigma_diag
819 real(kind=
kreal) :: omega
823 if (omega < 0.d0 .or. omega > 2.d0 .or. abs(omega) < epsilon(1.d0) &
824 .or. abs(omega - 2.d0) < epsilon(1.d0))
then
825 hecmat%Rarray(idx_r_omega) = 1.d0
827 hecmat%Rarray(idx_r_omega) = omega
840 real(kind=
kreal) :: thresh
842 hecmat%Rarray(idx_r_thresh) = thresh
854 real(kind=
kreal) :: filter
856 hecmat%Rarray(idx_r_filter) = filter
868 real(kind=
kreal) :: penalty
870 hecmat%Rarray(idx_r_penalty) = penalty
882 real(kind=
kreal) :: alpha
884 hecmat%Rarray(idx_r_penalty_alpha) = alpha
898 integer(kind=kint) :: ndiag, i
901 ndiag = hecmat%NDOF**2 * hecmat%NP
913 real(kind=
kreal),
pointer :: diag(:)
914 integer(kind=kint) :: i, k, idx, ndof, np
918 allocate(diag(ndof * np))
922 idx = ndof * ndof * (i - 1) + (k-1) * ndof + k
923 diag(ndof * (i - 1) + k) = hecmat%D(idx)
930 integer(kind=kint) :: nrecycle, maxrecycle
931 if (hecmat%Iarray(idx_i_flag_symbfact) >= 1)
then
932 hecmat%Iarray(idx_i_flag_numfact)=1
934 elseif (hecmat%Iarray(idx_i_flag_numfact) > 1)
then
936 hecmat%Iarray(idx_i_flag_numfact) = 1
937 elseif (hecmat%Iarray(idx_i_flag_numfact) == 1)
then
940 if ( nrecycle < maxrecycle )
then
941 hecmat%Iarray(idx_i_flag_numfact) = 0
957 if (
associated(src%D)) dest%D => src%D
958 if (
associated(src%B)) dest%B => src%B
959 if (
associated(src%X)) dest%X => src%X
960 if (
associated(src%AL)) dest%AL => src%AL
961 if (
associated(src%AU)) dest%AU => src%AU
962 if (
associated(src%indexL)) dest%indexL => src%indexL
963 if (
associated(src%indexU)) dest%indexU => src%indexU
964 if (
associated(src%itemL)) dest%itemL => src%itemL
965 if (
associated(src%itemU)) dest%itemU => src%itemU
966 dest%Iarray(:) = src%Iarray(:)
967 dest%Rarray(:) = src%Rarray(:)
985 integer(kind=kint) :: i, j, k, nn, pre, pp, js, je
987 nn = hecmat%NDOF * hecmat%NDOF
988 hecmat%NPA = hecmat%NP + hecmat%NPL + hecmat%NPU
989 if (
associated(hecmat%A))
deallocate(hecmat%A)
990 if (
associated(hecmat%indexA))
deallocate(hecmat%indexA)
991 if (
associated(hecmat%itemA))
deallocate(hecmat%itemA)
992 allocate (hecmat%A(nn * hecmat%NPA))
993 allocate (hecmat%indexA(0:hecmat%NP))
994 allocate (hecmat%itemA(hecmat%NPA))
1001 hecmat%indexA(i) = i + hecmat%indexL(i) + hecmat%indexU(i)
1003 pre = i - 1 + hecmat%indexU(i - 1)
1004 js= hecmat%indexL(i - 1) + 1
1005 je= hecmat%indexL(i )
1008 hecmat%itemA(pp) = hecmat%itemL(j)
1010 hecmat%A(nn * pp + k) = hecmat%AL(nn * j + k)
1014 pp = i + hecmat%indexU(i - 1) + hecmat%indexL(i)
1015 hecmat%itemA(pp) = i
1017 hecmat%A(nn * pp + k) = hecmat%D(nn * i + k)
1020 pre = i + hecmat%indexL(i)
1021 js= hecmat%indexU(i - 1) + 1
1022 je= hecmat%indexU(i )
1025 hecmat%itemA(pp) = hecmat%itemU(j)
1027 hecmat%A(nn * pp + k) = hecmat%AU(nn * j + k)
1036 real(kind=
kreal),
intent(inout) :: mat(9)
1037 #ifdef HECMW_ARCH_FX64
1039 real(kind=
kreal) :: tmp
integer(kind=kint) function, public hecmw_mat_get_solver_type(hecMAT)
subroutine, public hecmw_mat_set_usejad(hecMAT, usejad)
real(kind=kreal) function, dimension(:), pointer, public hecmw_mat_diag(hecMAT)
Extract diagonal components from matrix D into a 1D vector Returns: diag(i) = D(ndof*ndof*(node-1) + ...
subroutine, public hecmw_mat_set_ncolor_in(hecMAT, ncolor_in)
integer(kind=kint) function, public hecmw_mat_get_flag_diverged(hecMAT)
subroutine, public hecmw_mat_integrate(hecMAT)
Integrate matrix components into a single array for efficient access.
integer(kind=kint), parameter, public hecmw_matvec_impl_default
real(kind=kreal) function, public hecmw_mat_get_omega(hecMAT)
subroutine, public hecmw_mat_clear_flag_symbfact(hecMAT)
real(kind=kreal) function, public hecmw_mat_get_sigma_diag(hecMAT)
real(kind=kreal) function, public hecmw_mat_diag_max(hecMAT, hecMESH)
integer(kind=kint) function, public hecmw_mat_get_iterpremax(hecMAT)
subroutine, public hecmw_mat_set_contact_elim(hecMAT, contact_elim)
integer(kind=kint) function, public hecmw_mat_get_dump_exit(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_nrest(hecMAT)
subroutine, public hecmw_mat_init(hecMAT)
subroutine, public hecmw_mat_set_omega(hecMAT, omega)
subroutine, public hecmw_mat_set_iter(hecMAT, iter)
subroutine, public hecmw_mat_set_recompute_residual(hecMAT, recompute_residual)
subroutine, public hecmw_mat_set_iterlog(hecMAT, iterlog)
subroutine, public hecmw_mat_finalize(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_nrecycle_precond(hecMAT)
integer(kind=kint), parameter, public hecmw_matvec_impl_sblas
integer(kind=kint) function, public hecmw_mat_get_penalized(hecMAT)
subroutine, public hecmw_mat_copy_val(hecMATorg, hecMAT)
subroutine, public hecmw_mat_set_flag_diverged(hecMAT, flag_diverged)
subroutine, public hecmw_mat_set_penalized_b(hecMAT, penalized_b)
real(kind=kreal) function, public hecmw_mat_get_resid(hecMAT)
subroutine, public hecmw_mat_set_estcond(hecMAT, estcond)
integer(kind=kint) function, public hecmw_mat_get_maxrecycle_precond(hecMAT)
subroutine, public hecmw_mat_set_thresh(hecMAT, thresh)
integer(kind=kint), parameter, public hecmw_precond_impl_csr
subroutine, public hecmw_mat_block_transpose_33(mat)
subroutine, public hecmw_mat_set_flag_converged(hecMAT, flag_converged)
integer(kind=kint) function, public hecmw_mat_get_flag_converged(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_precond_impl(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_penalized_b(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_dump(hecMAT)
subroutine, public hecmw_mat_set_matvec_impl(hecMAT, matvec_impl)
real(kind=kreal) function, public hecmw_mat_get_penalty_alpha(hecMAT)
subroutine, public hecmw_mat_get_solver_opt(hecMAT, solver_opt)
subroutine, public hecmw_mat_set_solver_ropt(hecMAT, solver_ropt)
integer(kind=kint) function, public hecmw_mat_get_nbfgs(hecMAT)
subroutine, public hecmw_mat_substitute(dest, src)
real(kind=kreal) function, public hecmw_mat_get_penalty(hecMAT)
subroutine, public hecmw_mat_recycle_precond_setting(hecMAT)
subroutine, public hecmw_mat_incr_nrecycle_precond(hecMAT)
subroutine, public hecmw_mat_set_sigma_diag(hecMAT, sigma_diag)
subroutine, public hecmw_mat_set_penalty_alpha(hecMAT, alpha)
subroutine, public hecmw_mat_clear_b(hecMAT)
subroutine, public hecmw_mat_set_dump_exit(hecMAT, dump_exit)
integer(kind=kint) function, public hecmw_mat_get_iterlog(hecMAT)
subroutine, public hecmw_mat_set_flag_symbfact(hecMAT, flag_symbfact)
integer(kind=kint) function, public hecmw_mat_get_matvec_impl(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_timelog(hecMAT)
subroutine, public hecmw_mat_set_nset(hecMAT, nset)
integer(kind=kint), parameter, public hecmw_precond_impl_bsr
subroutine, public hecmw_mat_set_flag_numfact(hecMAT, flag_numfact)
integer(kind=kint) function, public hecmw_mat_get_loglevel(hecMAT)
subroutine, public hecmw_mat_copy_profile(hecMATorg, hecMAT)
subroutine, public hecmw_mat_set_method(hecMAT, method)
subroutine, public hecmw_mat_set_filter(hecMAT, filter)
integer(kind=kint) function, public hecmw_mat_get_method2(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_flag_numfact(hecMAT)
subroutine, public hecmw_mat_set_penalized(hecMAT, penalized)
subroutine, public hecmw_mat_set_penalty(hecMAT, penalty)
subroutine, public hecmw_mat_set_maxrecycle_precond(hecMAT, maxrecycle_precond)
subroutine, public hecmw_mat_clear(hecMAT)
subroutine, public hecmw_mat_set_precond_impl(hecMAT, precond_impl)
integer(kind=kint) function, public hecmw_mat_get_contact_elim(hecMAT)
subroutine, public hecmw_mat_set_timelog(hecMAT, timelog)
subroutine, public hecmw_mat_set_resid(hecMAT, resid)
real(kind=kreal) function, public hecmw_mat_get_thresh(hecMAT)
integer(kind=kint), parameter, public hecmw_precond_impl_sblas
integer(kind=kint) function, public hecmw_mat_get_flag_symbfact(hecMAT)
integer(kind=kint), parameter, public hecmw_precond_impl_default
integer(kind=kint) function, public hecmw_mat_get_recompute_residual(hecMAT)
integer(kind=kint), parameter, public hecmw_matvec_impl_bsr
integer(kind=kint) function, public hecmw_mat_get_method(hecMAT)
subroutine, public hecmw_mat_get_solver_ropt(hecMAT, solver_ropt)
integer(kind=kint) function, public hecmw_mat_get_precond(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_nset(hecMAT)
subroutine, public hecmw_mat_set_iterpremax(hecMAT, iterpremax)
real(kind=kreal) function, public hecmw_mat_get_filter(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_estcond(hecMAT)
subroutine, public hecmw_mat_set_nrest(hecMAT, nrest)
integer(kind=kint) function, public hecmw_mat_get_usejad(hecMAT)
subroutine, public hecmw_mat_set_solver_type(hecMAT, solver_type)
subroutine, public hecmw_mat_set_method2(hecMAT, method2)
integer(kind=kint) function, public hecmw_mat_get_mpc_method(hecMAT)
integer(kind=kint) function, public hecmw_mat_get_ncolor_in(hecMAT)
subroutine, public hecmw_mat_set_nbfgs(hecMAT, nbfgs)
integer(kind=kint) function, public hecmw_mat_get_iter(hecMAT)
integer(kind=kint), parameter, public hecmw_matvec_impl_csr
subroutine, public hecmw_mat_set_precond(hecMAT, precond)
subroutine, public hecmw_mat_set_solver_opt(hecMAT, solver_opt)
integer(kind=kint) function, public hecmw_mat_get_scaling(hecMAT)
subroutine, public hecmw_mat_reset_nrecycle_precond(hecMAT)
subroutine, public hecmw_mat_set_scaling(hecMAT, scaling)
subroutine, public hecmw_mat_set_mpc_method(hecMAT, mpc_method)
subroutine, public hecmw_mat_set_dump(hecMAT, dump_type)
subroutine, public hecmw_mat_set_loglevel(hecMAT, loglevel)
Diagnostic verbosity level, set independently of TIMELOG via the !SOLVER LOGLEVEL keyword (defaults t...
integer(kind=kint), parameter hecmw_max
integer(kind=4), parameter kreal
subroutine hecmw_nullify_matrix(P)
subroutine hecmw_allreduce_r1(hecMESH, s, ntag)