28 subroutine fstr_newton( cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, &
29 restrt_step_num, sub_step, ctime, dtime )
31 integer,
intent(in) :: cstep
32 type (hecmwST_local_mesh) :: hecMESH
33 type (hecmwST_matrix) :: hecMAT
34 type (fstr_solid) :: fstrSOLID
35 integer,
intent(in) :: sub_step
36 real(kind=kreal),
intent(in) :: ctime
37 real(kind=kreal),
intent(in) :: dtime
38 type (fstr_param) :: fstrPARAM
39 type (hecmwST_matrix_lagrange) :: hecLagMAT
41 type (hecmwST_local_mesh),
pointer :: hecMESHmpc
42 type (hecmwST_matrix),
pointer :: hecMATmpc
43 integer(kind=kint) :: ndof
44 integer(kind=kint) :: i, iter
45 integer(kind=kint) :: stepcnt
46 integer(kind=kint) :: restrt_step_num
47 real(kind=kreal) :: tt0, tt, res, qnrm, rres, tincr, xnrm, dunrm, rxnrm
48 real(kind=kreal),
allocatable :: coord(:), p(:)
49 logical :: isLinear = .false.
50 integer(kind=kint) :: iterStatus
52 call hecmw_mpc_mat_init(hecmesh, hecmat, hecmeshmpc, hecmatmpc)
54 if(.not.
fstrpr%nlgeom)
then
58 call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
60 allocate(p(hecmesh%n_node*ndof))
61 allocate(coord(hecmesh%n_node*ndof))
66 do iter=1,fstrsolid%step_ctrl(cstep)%max_iter
73 call fstr_addbc(cstep, hecmesh, hecmat, fstrsolid, fstrparam, heclagmat, stepcnt)
74 call hecmw_mpc_mat_ass(hecmesh, hecmat, hecmeshmpc, hecmatmpc)
75 call hecmw_mpc_trans_rhs(hecmesh, hecmat, hecmatmpc)
78 if( sub_step == restrt_step_num .and. iter == 1 ) hecmatmpc%Iarray(98) = 1
80 hecmatmpc%Iarray(97) = 2
82 hecmatmpc%Iarray(97) = 1
86 call solve_lineq(hecmeshmpc,hecmatmpc)
88 call hecmw_mpc_tback_sol(hecmesh, hecmat, hecmatmpc)
93 do i = 1, hecmesh%n_node*ndof
94 fstrsolid%dunode(i) = fstrsolid%dunode(i) + hecmat%X(i)
112 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
113 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
117 do i=1,hecmesh%n_node*ndof
118 fstrsolid%unode(i) = fstrsolid%unode(i) + fstrsolid%dunode(i)
123 fstrsolid%CutBack_stat = 0
126 call hecmw_mpc_mat_finalize(hecmesh, hecmat, hecmeshmpc, hecmatmpc)
133 restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT )
138 integer,
intent(in) :: cstep
139 type (hecmwST_local_mesh) :: hecMESH
140 type (hecmwST_matrix) :: hecMAT
141 type (fstr_solid) :: fstrSOLID
142 integer,
intent(in) :: sub_step
143 real(kind=kreal),
intent(in) :: ctime
144 real(kind=kreal),
intent(in) :: dtime
145 type (fstr_param) :: fstrPARAM
146 type (fstr_info_contactChange) :: infoCTChange
147 type (hecmwST_matrix_lagrange) :: hecLagMAT
148 type (hecmwST_matrix) :: conMAT
150 integer(kind=kint) :: ndof
151 integer(kind=kint) :: ctAlgo
152 integer(kind=kint) :: i, iter
153 integer(kind=kint) :: al_step, n_al_step, stepcnt
154 real(kind=kreal) :: tt0, tt, res, res0, res1, maxv, relres, tincr
155 integer(kind=kint) :: restart_step_num, restart_substep_num
156 logical :: convg, ctchange
157 integer(kind=kint) :: n_node_global
158 integer(kind=kint) :: contact_changed_global
159 real(kind=kreal),
allocatable :: coord(:)
160 integer(kind=kint) :: istat
164 n_node_global = hecmesh%nn_internal
165 call hecmw_allreduce_i1(hecmesh,n_node_global,hecmw_sum)
167 ctalgo = fstrparam%contact_algo
169 call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
171 if( cstep == 1 .and. sub_step == restart_substep_num )
then
172 call fstr_save_originalmatrixstructure(hecmat)
173 if(hecmesh%my_rank==0)
write(*,*)
"---Scanning initial contact state---"
175 call hecmw_mat_copy_profile( hecmat, conmat )
177 call fstr_mat_con_contact(cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat,
fstr_is_contact_active())
178 elseif( hecmat%Iarray(99)==4 )
then
179 write(*, *)
' This type of direct solver is not yet available in such case ! '
180 write(*, *)
' Please change the solver type to intel MKL direct solver !'
181 call hecmw_abort(hecmw_comm_get_comm())
189 allocate(coord(hecmesh%n_node*ndof))
191 call hecmw_mat_clear_b(conmat)
196 n_al_step = fstrsolid%step_ctrl(cstep)%max_contiter
199 do al_step = 1, n_al_step
201 if( hecmesh%my_rank == 0)
then
202 if( n_al_step > 1 )
then
203 print *,
"Augmentation step:", al_step
204 write(
imsg, *)
"Augmentation step:", al_step
213 do iter = 1,fstrsolid%step_ctrl(cstep)%max_iter
219 call hecmw_mat_clear( conmat )
223 if( al_step == 1 .and. stepcnt == 1 )
then
224 maxv = hecmw_mat_diag_max( hecmat, hecmesh )
232 call fstr_addbc(cstep, hecmesh, hecmat, fstrsolid, fstrparam, heclagmat, stepcnt, conmat)
241 call hecmw_update_r (hecmesh, hecmat%X, hecmat%NP, hecmesh%n_dof)
246 do i = 1, hecmesh%n_node*ndof
247 fstrsolid%dunode(i) = fstrsolid%dunode(i)+hecmat%X(i)
254 if( fstrsolid%DLOAD_follow /= 0 .or. fstrsolid%CLOAD_ngrp_rot /= 0 ) &
255 call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
260 call hecmw_mat_clear_b( conmat )
270 res = sqrt(res)/n_node_global
271 if( iter == 1 ) res0 = res
272 if( res0 == 0.0d0 )
then
275 relres = dabs( res1-res )/res0
278 if( hecmesh%my_rank == 0 )
then
279 write(*,
'(a,i3,a,2e15.7)')
' - Residual(',iter,
') =', res, relres
283 if( res < fstrsolid%step_ctrl(cstep)%converg .or. &
284 relres < fstrsolid%step_ctrl(cstep)%converg_ddisp )
exit
288 if( iter == fstrsolid%step_ctrl(cstep)%max_iter .or. res > fstrsolid%step_ctrl(cstep)%maxres .or. res /= res )
then
289 if( hecmesh%my_rank == 0)
then
290 write( *,
'(a,i5,a,i5)')
' ### Fail to Converge : at total_step=', cstep,
' sub_step=', sub_step
292 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
293 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
294 fstrsolid%NRstat_i(knstciter) = al_step
295 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
296 if( iter == fstrsolid%step_ctrl(cstep)%max_iter ) fstrsolid%NRstat_i(knstdresn) = 1
297 if( res > fstrsolid%step_ctrl(cstep)%maxres .or. res /= res ) fstrsolid%NRstat_i(knstdresn) = 2
304 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
305 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
309 call fstr_scan_contact_state( cstep, sub_step, al_step, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
311 contact_changed_global = 0
313 call fstr_mat_con_contact( cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat,
fstr_is_contact_active())
314 contact_changed_global = 1
316 call hecmw_allreduce_i1(hecmesh, contact_changed_global, hecmw_max)
317 if (contact_changed_global > 0)
then
318 call hecmw_mat_clear_b( hecmat )
319 call hecmw_mat_clear_b( conmat )
326 if( al_step >= fstrsolid%step_ctrl(cstep)%max_contiter )
then
327 if( hecmesh%my_rank == 0)
then
328 write( *,
'(a,i5,a,i5)')
' ### Contact failed to Converge : at total_step=', cstep,
' sub_step=', sub_step
330 fstrsolid%NRstat_i(knstciter) = al_step
331 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
332 fstrsolid%NRstat_i(knstdresn) = 3
340 call hecmw_mat_clear_b( conmat )
349 do i=1,hecmesh%n_node*ndof
350 fstrsolid%unode(i) = fstrsolid%unode(i)+fstrsolid%dunode(i)
353 fstrsolid%NRstat_i(knstciter) = al_step-1
358 fstrsolid%CutBack_stat = 0
365 restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT )
371 integer,
intent(in) :: cstep
372 type (hecmwST_local_mesh) :: hecMESH
373 type (hecmwST_matrix) :: hecMAT
374 type (fstr_solid) :: fstrSOLID
375 integer,
intent(in) :: sub_step
376 real(kind=kreal),
intent(in) :: ctime
377 real(kind=kreal),
intent(in) :: dtime
378 type (fstr_param) :: fstrPARAM
379 type (fstr_info_contactChange) :: infoCTChange
380 type (hecmwST_matrix_lagrange) :: hecLagMAT
381 type (hecmwST_matrix) :: conMAT
383 integer(kind=kint) :: ndof
384 integer(kind=kint) :: ctAlgo
385 integer(kind=kint) :: i, iter, max_iter_contact
386 integer(kind=kint) :: stepcnt, count_step
387 real(kind=kreal) :: tt0, tt, res, res0, res1, relres, tincr, resx
388 integer(kind=kint) :: restart_step_num, restart_substep_num
389 logical :: is_mat_symmetric
390 integer(kind=kint) :: n_node_global
391 integer(kind=kint) :: contact_changed_global
392 integer(kint) :: nndof
393 real(kreal) :: q_residual,x_residual
394 real(kind=kreal),
allocatable :: coord(:)
395 integer(kind=kint) :: istat
399 n_node_global = hecmesh%nn_internal
400 call hecmw_allreduce_i1(hecmesh,n_node_global,hecmw_sum)
402 if( hecmat%Iarray(99) == 4 .and. .not. fstr_is_matrixstruct_symmetric(fstrsolid, hecmesh) )
then
403 write(*, *)
' This type of direct solver is not yet available in such case ! '
404 write(*, *)
' Please use intel MKL direct solver !'
405 call hecmw_abort( hecmw_comm_get_comm() )
408 call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
410 ctalgo = fstrparam%contact_algo
411 do i=1,fstrsolid%n_contacts
412 fstrsolid%contacts(i)%ctime = ctime + dtime
414 if( cstep==1 .and. sub_step==restart_substep_num )
then
415 call fstr_save_originalmatrixstructure(hecmat)
417 call hecmw_mat_copy_profile( hecmat, conmat )
419 call fstr_mat_con_contact(cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat,
fstr_is_contact_active())
420 elseif( hecmat%Iarray(99)==4 )
then
421 write(*, *)
' This type of direct solver is not yet available in such case ! '
422 write(*, *)
' Please change the solver type to intel MKL direct solver !'
423 call hecmw_abort(hecmw_comm_get_comm())
425 is_mat_symmetric = fstr_is_matrixstruct_symmetric(fstrsolid, hecmesh)
429 call hecmw_mat_clear_b(conmat)
437 allocate(coord(hecmesh%n_node*ndof))
439 loopforcontactanalysis:
do while( .true. )
440 count_step = count_step+1
447 do iter = 1, fstrsolid%step_ctrl(cstep)%max_iter
448 call hecmw_barrier(hecmesh)
449 if(
myrank == 0 ) print *,
'-------------------------------------------------'
450 call hecmw_barrier(hecmesh)
456 call hecmw_mat_clear( conmat )
464 call fstr_addbc(cstep, hecmesh, hecmat, fstrsolid, fstrparam, heclagmat, stepcnt, conmat)
466 nndof = hecmat%N*hecmat%ndof
476 if( istat /= 0 )
then
477 if( hecmesh%my_rank == 0)
then
478 write( *,
'(a,i5,a,i5)')
' ### Fail to Converge : at total_step=', cstep,
' sub_step=', sub_step
480 fstrsolid%NRstat_i(knstdresn) = 4
481 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
487 call hecmw_innerproduct_r(hecmesh,ndof,hecmat%X,hecmat%X,resx)
488 resx = sqrt(resx)/n_node_global
490 if( hecmesh%my_rank==0 )
then
491 write(*,
'(a,i3,a,e15.7)')
' - ResidualX (',iter,
') =',resx
492 write(*,
'(a,i3,a,e15.7)')
' - ResidualX+LAG(',iter,
') =',sqrt(x_residual)/n_node_global
493 write(*,
'(a,i3,a,e15.7)')
' - ResidualQ (',iter,
') =',sqrt(q_residual)/n_node_global
497 do i = 1, hecmesh%n_node*ndof
498 fstrsolid%dunode(i) = fstrsolid%dunode(i) + hecmat%X(i)
503 do i = 1, heclagmat%num_lagrange
504 heclagmat%lagrange(i) = heclagmat%lagrange(i)+hecmat%X(hecmesh%n_node*ndof+i)
512 if( fstrsolid%DLOAD_follow /= 0 .or. fstrsolid%CLOAD_ngrp_rot /= 0 ) &
513 call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
518 call hecmw_mat_clear_b( conmat )
524 res = sqrt(res)/n_node_global
525 if( iter == 1 ) res0 = res
526 if( res0 == 0.0d0 )
then
529 relres = dabs( res1-res )/res0
531 if( hecmesh%my_rank == 0 )
then
532 write(*,
'(a,i3,a,2e15.7)')
' - Residual(',iter,
') =',res,relres
536 if( res < fstrsolid%step_ctrl(cstep)%converg .or. &
537 relres < fstrsolid%step_ctrl(cstep)%converg_ddisp )
exit
541 if( iter == fstrsolid%step_ctrl(cstep)%max_iter .or. res > fstrsolid%step_ctrl(cstep)%maxres .or. res /= res )
then
542 if( hecmesh%my_rank == 0)
then
543 write( *,
'(a,i5,a,i5)')
' ### Fail to Converge : at total_step=', cstep,
' sub_step=', sub_step
545 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
546 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
547 fstrsolid%NRstat_i(knstciter) = count_step
548 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
549 if( iter == fstrsolid%step_ctrl(cstep)%max_iter ) fstrsolid%NRstat_i(knstdresn) = 1
550 if( res > fstrsolid%step_ctrl(cstep)%maxres .or. res /= res ) fstrsolid%NRstat_i(knstdresn) = 2
557 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
558 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
560 call fstr_scan_contact_state( cstep, sub_step, count_step, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
563 write(*, *)
' This type of direct solver is not yet available in such case ! '
564 write(*, *)
' Please use intel MKL direct solver !'
565 call hecmw_abort( hecmw_comm_get_comm() )
568 is_mat_symmetric = fstr_is_matrixstruct_symmetric(fstrsolid, hecmesh)
569 contact_changed_global = 0
571 call fstr_mat_con_contact( cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat,
fstr_is_contact_active())
572 contact_changed_global = 1
577 call hecmw_allreduce_i1(hecmesh, contact_changed_global, hecmw_max)
578 if (contact_changed_global > 0)
then
579 call hecmw_mat_clear_b( hecmat )
580 call hecmw_mat_clear_b( conmat )
585 if( count_step >= fstrsolid%step_ctrl(cstep)%max_contiter )
then
586 if( hecmesh%my_rank == 0)
then
587 write( *,
'(a,i5,a,i5)')
' ### Contact failed to Converge : at total_step=', cstep,
' sub_step=', sub_step
589 fstrsolid%NRstat_i(knstciter) = count_step
590 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
591 fstrsolid%NRstat_i(knstdresn) = 3
599 call hecmw_mat_clear_b( conmat )
603 enddo loopforcontactanalysis
605 fstrsolid%NRstat_i(knstciter) = count_step
609 do i = 1, hecmesh%n_node*ndof
610 fstrsolid%unode(i) = fstrsolid%unode(i)+fstrsolid%dunode(i)
621 fstrsolid%CutBack_stat = 0
624 subroutine fstr_init_newton(hecMESH, hecMAT, fstrSOLID, ctime, tincr, iter, cstep, dtime, fstrPARAM, hecLagMAT, ndof)
627 type (hecmwST_local_mesh) :: hecMESH
628 type (hecmwST_matrix) :: hecMAT
629 type (fstr_solid) :: fstrSOLID
630 real(kind=kreal),
intent(in) :: ctime
631 real(kind=kreal),
intent(in) :: dtime
632 type (fstr_param) :: fstrPARAM
633 real(kind=kreal),
intent(inout) :: tincr
634 integer(kind=kint) :: iter
635 integer,
intent(in) :: cstep
636 type (hecmwST_matrix_lagrange) :: hecLagMAT
637 integer(kind=kint),
intent(inout) :: ndof
639 hecmat%NDOF = hecmesh%n_dof
643 if( fstrsolid%step_ctrl(cstep)%solution == stepstatic ) tincr = 0.d0
645 fstrsolid%dunode(:) = 0.0d0
646 fstrsolid%NRstat_i(:) = 0
648 call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
654 integer(kind=kint) :: iterstatus
656 type (hecmwst_local_mesh) :: hecmesh
657 type (hecmwst_matrix) :: hecmat
659 integer(kind=kint),
intent(in) :: ndof
660 integer(kind=kint),
intent(in) :: iter
661 integer(kind=kint),
intent(in) :: sub_step, cstep
663 real(kind=kreal) :: res, qnrm, rres, xnrm, dunrm, rxnrm
667 call hecmw_innerproduct_r(hecmesh, ndof, hecmat%B, hecmat%B, res)
669 call hecmw_innerproduct_r(hecmesh, ndof, hecmat%X, hecmat%X, xnrm)
671 call hecmw_innerproduct_r(hecmesh, ndof, fstrsolid%QFORCE, fstrsolid%QFORCE, qnrm)
673 if (qnrm < 1.0d-8) qnrm = 1.0d0
677 call hecmw_innerproduct_r(hecmesh, ndof, fstrsolid%dunode, fstrsolid%dunode, dunrm)
683 if( hecmesh%my_rank == 0 )
then
684 if (qnrm == 1.0d0)
then
685 write(*,
"(a,i8,a,1pe11.4,a,1pe11.4)")
" iter:", iter,
", residual(abs):", rres,
", disp.corr.:", rxnrm
687 write(*,
"(a,i8,a,1pe11.4,a,1pe11.4)")
" iter:", iter,
", residual:", rres,
", disp.corr.:", rxnrm
690 if( hecmw_mat_get_flag_diverged(hecmat) ==
kno )
then
691 if( rres < fstrsolid%step_ctrl(cstep)%converg .or. &
692 rxnrm < fstrsolid%step_ctrl(cstep)%converg_ddisp )
then
699 if ( iter == fstrsolid%step_ctrl(cstep)%max_iter .or. rres > fstrsolid%step_ctrl(cstep)%maxres) &
703 if( hecmesh%my_rank == 0)
then
704 write(
ilog,
'(a,i5,a,i5)')
'### Fail to Converge : at total_step=', cstep,
' sub_step=', sub_step
705 write( *,
'(a,i5,a,i5)')
' ### Fail to Converge : at total_step=', cstep,
' sub_step=', sub_step
707 fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter)
708 fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter
709 fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
710 if( iter == fstrsolid%step_ctrl(cstep)%max_iter ) fstrsolid%NRstat_i(knstdresn) = 1
711 if( rres > fstrsolid%step_ctrl(cstep)%maxres .or. rres /= rres ) fstrsolid%NRstat_i(knstdresn) = 2