FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
fstr_solve_NonLinear.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 !-------------------------------------------------------------------------------
6 
8 
9  use m_fstr
10  use m_static_lib
11  use m_static_output
12 
13  use m_fstr_spring
15  use m_fstr_update
16  use m_fstr_ass_load
17  use m_fstr_addbc
18  use m_fstr_residual
19  use m_fstr_restart
20 
21  implicit none
22 
23  contains
24 
25 
28  subroutine fstr_newton( cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, &
29  restrt_step_num, sub_step, ctime, dtime )
30 
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
40 
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
51 
52  call hecmw_mpc_mat_init(hecmesh, hecmat, hecmeshmpc, hecmatmpc)
53 
54  if(.not. fstrpr%nlgeom)then
55  islinear = .true.
56  endif
57 
58  call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
59 
60  allocate(p(hecmesh%n_node*ndof))
61  allocate(coord(hecmesh%n_node*ndof))
62  p = 0.0d0
63  stepcnt = 0
64 
65  ! ----- Inner Iteration, lagrange multiplier constant
66  do iter=1,fstrsolid%step_ctrl(cstep)%max_iter
67  stepcnt = stepcnt+1
68 
69  call fstr_stiffmatrix( hecmesh, hecmat, fstrsolid, ctime, tincr )
70  call fstr_addspring(cstep, hecmesh, hecmat, fstrsolid, fstrparam)
71 
72  ! ----- Set Boundary condition
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)
76 
77  !----- SOLVE [Kt]{du}={R}
78  if( sub_step == restrt_step_num .and. iter == 1 ) hecmatmpc%Iarray(98) = 1
79  if( iter == 1 ) then
80  hecmatmpc%Iarray(97) = 2 !Force numerical factorization
81  else
82  hecmatmpc%Iarray(97) = 1 !Need numerical factorization
83  endif
84  hecmatmpc%X = 0.0d0
85  call fstr_set_current_config_to_mesh(hecmeshmpc,fstrsolid,coord)
86  call solve_lineq(hecmeshmpc,hecmatmpc)
87  call fstr_recover_initial_config_to_mesh(hecmeshmpc,fstrsolid,coord)
88  call hecmw_mpc_tback_sol(hecmesh, hecmat, hecmatmpc)
89 
90  ! ----- update the small displacement and the displacement for 1step
91  ! \delta u^k => solver's solution
92  ! \Delta u_{n+1}^{k} = \Delta u_{n+1}^{k-1} + \delta u^k
93  do i = 1, hecmesh%n_node*ndof
94  fstrsolid%dunode(i) = fstrsolid%dunode(i) + hecmat%X(i)
95  enddo
96 
97  call fstr_calc_residual_vector(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam)
98 
99  ! do i = 1, hecMESH%n_node*ndof
100  ! write(6,*) fstrSOLID%dunode(i), fstrSOLID%QFORCE(i), fstrSOLID%GL(i)
101  ! enddo
102 
103  if( islinear ) exit
104 
105  ! ----- check convergence
106  iterstatus = fstr_check_iteration_converged(hecmesh, hecmat, fstrsolid, ndof, iter, sub_step, cstep)
107  if (iterstatus == kitrconverged) exit
108  if (iterstatus == kitrdiverged .or. iterstatus==kitrfloatingerror) return
109  enddo
110  ! ----- end of inner loop
111 
112  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
113  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sum of iter)
114 
115  ! ----- update the total displacement
116  ! u_{n+1} = u_{n} + \Delta u_{n+1}
117  do i=1,hecmesh%n_node*ndof
118  fstrsolid%unode(i) = fstrsolid%unode(i) + fstrsolid%dunode(i)
119  enddo
120 
121  call fstr_updatestate( hecmesh, fstrsolid, tincr )
122 
123  fstrsolid%CutBack_stat = 0
124  deallocate(coord)
125  deallocate(p)
126  call hecmw_mpc_mat_finalize(hecmesh, hecmat, hecmeshmpc, hecmatmpc)
127  end subroutine fstr_newton
128 
132  subroutine fstr_newton_contactalag( cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, &
133  restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT )
137 
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
149 
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
161 
162 
163  ! sum of n_node among all subdomains (to be used to calc res)
164  n_node_global = hecmesh%nn_internal
165  call hecmw_allreduce_i1(hecmesh,n_node_global,hecmw_sum)
166 
167  ctalgo = fstrparam%contact_algo
168 
169  call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
170 
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---"
174  call fstr_scan_contact_state( cstep, sub_step, 0, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
175  call hecmw_mat_copy_profile( hecmat, conmat )
176  if ( fstr_is_contact_active() ) then
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())
182  endif
183  call solve_lineq_contact_init(hecmesh, hecmat, heclagmat, .true.)
184  endif
185 
186  hecmat%X = 0.0d0
187 
188  stepcnt = 0
189  allocate(coord(hecmesh%n_node*ndof))
190 
191  call hecmw_mat_clear_b(conmat)
192 
193  if( fstr_is_contact_active() ) call fstr_ass_load_contactalag( hecmesh, fstrsolid, conmat%B )
194 
195  ! ----- Augmentation loop. In case of no contact, it is inactive
196  n_al_step = fstrsolid%step_ctrl(cstep)%max_contiter
197  if( .not. fstr_is_contact_active() ) n_al_step = 1
198 
199  do al_step = 1, n_al_step
200 
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
205  endif
206  end if
207 
208  ! ----- Inner Iteration, lagrange multiplier constant
209  res0 = 0.0d0
210  res1 = 0.0d0
211  relres = 1.0d0
212 
213  do iter = 1,fstrsolid%step_ctrl(cstep)%max_iter
214  stepcnt = stepcnt+1
215 
216  call fstr_stiffmatrix( hecmesh, hecmat, fstrsolid, ctime, tincr )
217  call fstr_addspring(cstep, hecmesh, hecmat, fstrsolid, fstrparam)
218 
219  call hecmw_mat_clear( conmat )
220  conmat%X = 0.0d0
221 
222  ! ----- Contact
223  if( al_step == 1 .and. stepcnt == 1 ) then
224  maxv = hecmw_mat_diag_max( hecmat, hecmesh )
225  call fstr_set_contact_penalty( maxv )
226  endif
227  if( fstr_is_contact_active() ) then
228  call fstr_contactbc( cstep, iter, hecmesh, conmat, fstrsolid )
229  endif
230 
231  ! ----- Set Boundary condition
232  call fstr_addbc(cstep, hecmesh, hecmat, fstrsolid, fstrparam, heclagmat, stepcnt, conmat)
233 
234  !----- SOLVE [Kt]{du}={R}
235  ! ---- For Parallel Contact with Multi-Partition Domains
236  hecmat%X = 0.0d0
237  call fstr_set_current_config_to_mesh(hecmesh,fstrsolid,coord)
238  call solve_lineq_contact(hecmesh, hecmat, heclagmat, conmat, istat, 1.0d0, fstr_is_contact_active())
239  call fstr_recover_initial_config_to_mesh(hecmesh,fstrsolid,coord)
240 
241  call hecmw_update_r (hecmesh, hecmat%X, hecmat%NP, hecmesh%n_dof)
242 
243  ! ----- update the small displacement and the displacement for 1step
244  ! \delta u^k => solver's solution
245  ! \Delta u_{n+1}^{k} = \Delta u_{n+1}^{k-1} + \delta u^k
246  do i = 1, hecmesh%n_node*ndof
247  fstrsolid%dunode(i) = fstrsolid%dunode(i)+hecmat%X(i)
248  enddo
249 
250  ! ----- update the strain, stress, and internal force
251  call fstr_updatenewton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter)
252 
253  ! ----- Set residual
254  if( fstrsolid%DLOAD_follow /= 0 .or. fstrsolid%CLOAD_ngrp_rot /= 0 ) &
255  call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
256 
257  call fstr_update_ndforce(cstep, hecmesh, hecmat, fstrsolid, conmat)
258 
259  if( fstr_is_contact_active() ) then
260  call hecmw_mat_clear_b( conmat )
261  call fstr_update_contact0(hecmesh, fstrsolid, conmat%B)
262  endif
263  ! Consider SPC condition
264  call fstr_update_ndforce_spc(cstep, hecmesh, fstrsolid, hecmat%B)
265  call fstr_update_ndforce_spc(cstep, hecmesh, fstrsolid, conmat%B)
266 
267  !res = fstr_get_residual(hecMAT%B, hecMESH)
268  res = fstr_get_norm_para_contact(hecmat,heclagmat,conmat,hecmesh)
269  ! ----- Gather global residual
270  res = sqrt(res)/n_node_global
271  if( iter == 1 ) res0 = res
272  if( res0 == 0.0d0 ) then
273  res0 = 1.0d0
274  else
275  relres = dabs( res1-res )/res0
276  endif
277 
278  if( hecmesh%my_rank == 0 ) then
279  write(*, '(a,i3,a,2e15.7)') ' - Residual(',iter,') =', res, relres
280  endif
281 
282  ! ----- check convergence
283  if( res < fstrsolid%step_ctrl(cstep)%converg .or. &
284  relres < fstrsolid%step_ctrl(cstep)%converg_ddisp ) exit
285  res1 = res
286 
287  ! ----- check divergence and NaN
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
291  end if
292  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
293  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sumofiter)
294  fstrsolid%NRstat_i(knstciter) = al_step ! logging contact iteration
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
298  return
299  end if
300 
301  enddo
302  ! ----- end of inner loop
303 
304  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
305  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sum of iter)
306 
307  ! ----- deal with contact boundary
308  call fstr_update_contact_multiplier( hecmesh, fstrsolid, ctchange )
309  call fstr_scan_contact_state( cstep, sub_step, al_step, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
310 
311  contact_changed_global = 0
312  if( fstr_is_matrixstructure_changed(infoctchange) ) then
313  call fstr_mat_con_contact( cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat, fstr_is_contact_active())
314  contact_changed_global = 1
315  endif
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 )
320  call solve_lineq_contact_init(hecmesh, hecmat, heclagmat, .true.)
321  endif
322 
323  if( fstr_is_contact_conv(ctalgo,infoctchange,hecmesh) .and. .not. ctchange ) exit
324 
325  ! ----- check divergence
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
329  end if
330  fstrsolid%NRstat_i(knstciter) = al_step ! logging contact iteration
331  fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
332  fstrsolid%NRstat_i(knstdresn) = 3
333  return
334  end if
335 
336  ! ----- Set residual for next newton iteration
337  call fstr_update_ndforce(cstep,hecmesh,hecmat,fstrsolid,conmat )
338 
339  if( fstr_is_contact_active() ) then
340  call hecmw_mat_clear_b( conmat )
341  call fstr_update_contact0(hecmesh, fstrsolid, conmat%B)
342  endif
343 
344  enddo
345  ! ----- end of augmentation loop
346 
347  ! ----- update the total displacement
348  ! u_{n+1} = u_{n} + \Delta u_{n+1}
349  do i=1,hecmesh%n_node*ndof
350  fstrsolid%unode(i) = fstrsolid%unode(i)+fstrsolid%dunode(i)
351  enddo
352 
353  fstrsolid%NRstat_i(knstciter) = al_step-1 ! logging contact iteration
354 
355  call fstr_updatestate( hecmesh, fstrsolid, tincr )
356 
357  deallocate(coord)
358  fstrsolid%CutBack_stat = 0
359  end subroutine fstr_newton_contactalag
360 
361 
364  subroutine fstr_newton_contactslag( cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, hecLagMAT, &
365  restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT )
366 
367  use mcontact
370 
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
382 
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
396 
397 
398  ! sum of n_node among all subdomains (to be used to calc res)
399  n_node_global = hecmesh%nn_internal
400  call hecmw_allreduce_i1(hecmesh,n_node_global,hecmw_sum)
401 
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() )
406  endif
407 
408  call fstr_init_newton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter, cstep, dtime, fstrparam, heclagmat, ndof)
409 
410  ctalgo = fstrparam%contact_algo
411  do i=1,fstrsolid%n_contacts
412  fstrsolid%contacts(i)%ctime = ctime + dtime
413  enddo
414  if( cstep==1 .and. sub_step==restart_substep_num ) then
415  call fstr_save_originalmatrixstructure(hecmat)
416  call fstr_scan_contact_state( cstep, sub_step, 0, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
417  call hecmw_mat_copy_profile( hecmat, conmat )
418  if ( fstr_is_contact_active() ) then
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())
424  endif
425  is_mat_symmetric = fstr_is_matrixstruct_symmetric(fstrsolid, hecmesh)
426  call solve_lineq_contact_init(hecmesh, hecmat, heclagmat, is_mat_symmetric)
427  endif
428 
429  call hecmw_mat_clear_b(conmat)
430 
431  if( fstr_is_contact_active() ) then
432  call fstr_ass_load_contact(cstep, hecmesh, conmat, fstrsolid, heclagmat)
433  endif
434 
435  stepcnt = 0
436  count_step = 0
437  allocate(coord(hecmesh%n_node*ndof))
438 
439  loopforcontactanalysis: do while( .true. )
440  count_step = count_step+1
441 
442  ! ----- Inner Iteration
443  res0 = 0.d0
444  res1 = 0.d0
445  relres = 1.d0
446 
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)
451  stepcnt = stepcnt+1
452 
453  call fstr_stiffmatrix(hecmesh, hecmat, fstrsolid, ctime, tincr)
454  call fstr_addspring(cstep, hecmesh, hecmat, fstrsolid, fstrparam)
455 
456  call hecmw_mat_clear( conmat )
457  conmat%X = 0.0d0
458 
459  if( fstr_is_contact_active() ) then
460  call fstr_addcontactstiffness(cstep,iter,conmat,heclagmat,fstrsolid)
461  endif
462 
463  ! ----- Set Boundary condition
464  call fstr_addbc(cstep, hecmesh, hecmat, fstrsolid, fstrparam, heclagmat, stepcnt, conmat)
465 
466  nndof = hecmat%N*hecmat%ndof
467 
468  !----- SOLVE [Kt]{du}={R}
469  ! ---- For Parallel Contact with Multi-Partition Domains
470  hecmat%X = 0.0d0
471  call fstr_set_current_config_to_mesh(hecmesh,fstrsolid,coord)
472  q_residual = fstr_get_norm_para_contact(hecmat,heclagmat,conmat,hecmesh)
473  call solve_lineq_contact(hecmesh, hecmat, heclagmat, conmat, istat, 1.0d0, fstr_is_contact_active())
474  call fstr_recover_initial_config_to_mesh(hecmesh,fstrsolid,coord)
475  ! ----- check matrix solver error
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
479  end if
480  fstrsolid%NRstat_i(knstdresn) = 4
481  fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
482  return
483  end if
484 
485  x_residual = fstr_get_x_norm_contact(hecmat,heclagmat,hecmesh)
486 
487  call hecmw_innerproduct_r(hecmesh,ndof,hecmat%X,hecmat%X,resx)
488  resx = sqrt(resx)/n_node_global
489 
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
494  endif
495 
496  ! ----- update the small displacement and the displacement for 1step
497  do i = 1, hecmesh%n_node*ndof
498  fstrsolid%dunode(i) = fstrsolid%dunode(i) + hecmat%X(i)
499  enddo
500 
501  ! ----- update the Lagrange multipliers
502  if( fstr_is_contact_active() ) then
503  do i = 1, heclagmat%num_lagrange
504  heclagmat%lagrange(i) = heclagmat%lagrange(i)+hecmat%X(hecmesh%n_node*ndof+i)
505  enddo
506  endif
507 
508  ! ----- update the strain, stress, and internal force (only QFORCE)
509  call fstr_updatenewton(hecmesh, hecmat, fstrsolid, ctime, tincr, iter)
510 
511  ! ----- Set residual
512  if( fstrsolid%DLOAD_follow /= 0 .or. fstrsolid%CLOAD_ngrp_rot /= 0 ) &
513  call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
514 
515  call fstr_update_ndforce(cstep,hecmesh,hecmat,fstrsolid,conmat )
516 
517  if( fstr_is_contact_active() ) then
518  call hecmw_mat_clear_b( conmat )
519  call fstr_update_ndforce_contact(cstep,hecmesh,hecmat,heclagmat,fstrsolid,conmat)
520  endif
521 
522  res = fstr_get_norm_para_contact(hecmat,heclagmat,conmat,hecmesh)
523 
524  res = sqrt(res)/n_node_global
525  if( iter == 1 ) res0 = res
526  if( res0 == 0.0d0 ) then
527  res0 =1.0d0
528  else
529  relres = dabs( res1-res )/res0
530  endif
531  if( hecmesh%my_rank == 0 ) then
532  write(*, '(a,i3,a,2e15.7)') ' - Residual(',iter,') =',res,relres
533  endif
534 
535  ! ----- check convergence
536  if( res < fstrsolid%step_ctrl(cstep)%converg .or. &
537  relres < fstrsolid%step_ctrl(cstep)%converg_ddisp ) exit
538  res1 = res
539 
540  ! ----- check divergence and NaN
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
544  end if
545  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
546  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sumofiter)
547  fstrsolid%NRstat_i(knstciter) = count_step ! logging contact iteration
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
551  return
552  end if
553 
554  enddo
555  ! ----- end of inner loop
556 
557  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
558  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sum of iter)
559 
560  call fstr_scan_contact_state( cstep, sub_step, count_step, dtime, ctalgo, hecmesh, fstrsolid, infoctchange, hecmat%B )
561 
562  if( hecmat%Iarray(99) == 4 .and. .not. fstr_is_contact_active() ) then
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() )
566  endif
567 
568  is_mat_symmetric = fstr_is_matrixstruct_symmetric(fstrsolid, hecmesh)
569  contact_changed_global = 0
570  if( fstr_is_matrixstructure_changed(infoctchange) ) then
571  call fstr_mat_con_contact( cstep, ctalgo, hecmat, fstrsolid, heclagmat, infoctchange, conmat, fstr_is_contact_active())
572  contact_changed_global = 1
573  endif
574 
575  if( fstr_is_contact_conv(ctalgo,infoctchange,hecmesh) ) exit loopforcontactanalysis
576 
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 )
581  call solve_lineq_contact_init(hecmesh, hecmat, heclagmat, is_mat_symmetric)
582  endif
583 
584  ! ----- check divergence
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
588  end if
589  fstrsolid%NRstat_i(knstciter) = count_step ! logging contact iteration
590  fstrsolid%CutBack_stat = fstrsolid%CutBack_stat + 1
591  fstrsolid%NRstat_i(knstdresn) = 3
592  return
593  end if
594 
595  ! ----- Set residual for next newton iteration
596  call fstr_update_ndforce(cstep,hecmesh,hecmat,fstrsolid,conmat )
597 
598  if( fstr_is_contact_active() ) then
599  call hecmw_mat_clear_b( conmat )
600  call fstr_update_ndforce_contact(cstep,hecmesh,hecmat,heclagmat,fstrsolid,conmat)
601  endif
602 
603  enddo loopforcontactanalysis
604 
605  fstrsolid%NRstat_i(knstciter) = count_step ! logging contact iteration
606 
607  ! ----- update the total displacement
608  ! u_{n+1} = u_{n} + \Delta u_{n+1}
609  do i = 1, hecmesh%n_node*ndof
610  fstrsolid%unode(i) = fstrsolid%unode(i)+fstrsolid%dunode(i)
611  enddo
612 
613  call fstr_updatestate(hecmesh, fstrsolid, tincr)
614  call fstr_update_contact_tangentforce( fstrsolid )
615  if( fstrsolid%n_embeds > 0 .and. paracontactflag ) then
616  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%EMBED_NFORCE,1)
617  call fstr_update_ndforce_spc( cstep, hecmesh, fstrsolid, hecmat%B )
618  endif
619 
620  deallocate(coord)
621  fstrsolid%CutBack_stat = 0
622  end subroutine fstr_newton_contactslag
623 
624  subroutine fstr_init_newton(hecMESH, hecMAT, fstrSOLID, ctime, tincr, iter, cstep, dtime, fstrPARAM, hecLagMAT, ndof)
626  implicit none
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
638 
639  hecmat%NDOF = hecmesh%n_dof
640  ndof = hecmat%ndof
641 
642  tincr = dtime
643  if( fstrsolid%step_ctrl(cstep)%solution == stepstatic ) tincr = 0.d0
644 
645  fstrsolid%dunode(:) = 0.0d0
646  fstrsolid%NRstat_i(:) = 0 ! logging newton iteration(init)
647 
648  call fstr_ass_load(cstep, ctime+dtime, hecmesh, hecmat, fstrsolid, fstrparam)
649  end subroutine fstr_init_newton
650 
652  function fstr_check_iteration_converged(hecMESH, hecMAT, fstrSOLID, ndof, iter, sub_step, cstep) result(iterStatus)
653  implicit none
654  integer(kind=kint) :: iterstatus
655 
656  type (hecmwst_local_mesh) :: hecmesh
657  type (hecmwst_matrix) :: hecmat
658  type (fstr_solid) :: fstrsolid
659  integer(kind=kint), intent(in) :: ndof
660  integer(kind=kint), intent(in) :: iter
661  integer(kind=kint), intent(in) :: sub_step, cstep
662 
663  real(kind=kreal) :: res, qnrm, rres, xnrm, dunrm, rxnrm
664 
665  iterstatus = kitrcontinue
666 
667  call hecmw_innerproduct_r(hecmesh, ndof, hecmat%B, hecmat%B, res)
668  res = sqrt(res)
669  call hecmw_innerproduct_r(hecmesh, ndof, hecmat%X, hecmat%X, xnrm)
670  xnrm = sqrt(xnrm)
671  call hecmw_innerproduct_r(hecmesh, ndof, fstrsolid%QFORCE, fstrsolid%QFORCE, qnrm)
672  qnrm = sqrt(qnrm)
673  if (qnrm < 1.0d-8) qnrm = 1.0d0
674  if( iter == 1 ) then
675  dunrm = xnrm
676  else
677  call hecmw_innerproduct_r(hecmesh, ndof, fstrsolid%dunode, fstrsolid%dunode, dunrm)
678  dunrm = sqrt(dunrm)
679  endif
680  rres = res/qnrm
681  rxnrm = xnrm/dunrm
682 
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
686  else
687  write(*,"(a,i8,a,1pe11.4,a,1pe11.4)")" iter:", iter, ", residual:", rres, ", disp.corr.:", rxnrm
688  endif
689  endif
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
693  iterstatus=kitrconverged
694  return
695  endif
696  endif
697 
698  ! ----- check divergence and NaN
699  if ( iter == fstrsolid%step_ctrl(cstep)%max_iter .or. rres > fstrsolid%step_ctrl(cstep)%maxres) &
700  iterstatus = kitrdiverged
701  if (rres /= rres ) iterstatus = kitrfloatingerror
702  if (iterstatus /= kitrcontinue) then
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
706  end if
707  fstrsolid%NRstat_i(knstmaxit) = max(fstrsolid%NRstat_i(knstmaxit),iter) ! logging newton iteration(maxtier)
708  fstrsolid%NRstat_i(knstsumit) = fstrsolid%NRstat_i(knstsumit) + iter ! logging newton iteration(sumofiter)
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
712  return
713  end if
714  end function fstr_check_iteration_converged
715 
716 end module m_fstr_nonlinearmethod
m_fstr::kitrfloatingerror
integer(kind=kint), parameter kitrfloatingerror
Definition: m_fstr.f90:92
m_addcontactstiffness
This module provides functions: 1) obtain contact stiffness matrix of each contact pair and assemble ...
Definition: fstr_AddContactStiff.f90:13
mcontact::fstr_scan_contact_state
subroutine fstr_scan_contact_state(cstep, sub_step, cont_step, dt, ctAlgo, hecMESH, fstrSOLID, infoCTChange, B)
Scanning contact state.
Definition: fstr_contact.f90:212
m_fstr_ass_load
This module provides functions to take into account external load.
Definition: fstr_ass_load.f90:7
m_fstr_residual::fstr_get_x_norm_contact
real(kind=kreal) function, public fstr_get_x_norm_contact(hecMAT, hecLagMAT, hecMESH)
Definition: fstr_Residual.f90:276
m_fstr::myrank
integer(kind=kint) myrank
PARALLEL EXECUTION.
Definition: m_fstr.f90:96
m_fstr_update
This module provides function to calculate to do updates.
Definition: fstr_Update.f90:6
m_solve_lineq_contact
This module provides functions to solve sparse system of \linear equitions in the case of contact ana...
Definition: hecmw_solver_contact.f90:9
m_fstr_nonlinearmethod::fstr_newton_contactslag
subroutine fstr_newton_contactslag(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, hecLagMAT, restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT)
This subroutine solve nonlinear solid mechanics problems by Newton-Raphson method....
Definition: fstr_solve_NonLinear.f90:366
m_fstr_stiffmatrix::fstr_stiffmatrix
subroutine, public fstr_stiffmatrix(hecMESH, hecMAT, fstrSOLID, time, tincr)
This subroutine creates tangential stiffness matrix.
Definition: fstr_StiffMatrix.f90:19
m_fstr::kno
integer(kind=kint), parameter kno
Definition: m_fstr.f90:31
m_fstr_residual::fstr_calc_residual_vector
subroutine fstr_calc_residual_vector(hecMESH, hecMAT, fstrSOLID, ctime, tincr, iter, cstep, dtime, fstrPARAM)
\breaf This subroutine calculate residual vector
Definition: fstr_Residual.f90:142
m_fstr::fstr_solid
Definition: m_fstr.f90:239
m_addcontactstiffness::fstr_update_ndforce_contact
subroutine, public fstr_update_ndforce_contact(cstep, hecMESH, hecMAT, hecLagMAT, fstrSOLID, conMAT)
This subroutine obtains contact nodal force vector of each contact pair and assembles it into right-h...
Definition: fstr_AddContactStiff.f90:257
m_static_output
This module provides functions to output result.
Definition: static_output.f90:6
m_fstr_spring::fstr_addspring
subroutine fstr_addspring(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM)
Definition: fstr_Spring.f90:12
m_fstr_residual
This module provides function to calculate residual of nodal force.
Definition: fstr_Residual.f90:7
mcontact::fstr_contactbc
subroutine fstr_contactbc(cstep, iter, hecMESH, hecMAT, fstrSOLID)
Introduce contact stiff into global stiff matrix or mpc conditions into hecMESH.
Definition: fstr_contact.f90:480
m_fstr::fstrpr
type(fstr_param), target fstrpr
GLOBAL VARIABLE INITIALIZED IN FSTR_SETUP.
Definition: m_fstr.f90:209
m_fstr::kitrcontinue
integer(kind=kint), parameter kitrcontinue
iteration control
Definition: m_fstr.f90:89
m_fstr::kitrconverged
integer(kind=kint), parameter kitrconverged
Definition: m_fstr.f90:90
mcontact::fstr_update_contact0
subroutine fstr_update_contact0(hecMESH, fstrSOLID, B)
Update lagrangian multiplier.
Definition: fstr_contact.f90:393
mcontact::fstr_is_matrixstructure_changed
logical function fstr_is_matrixstructure_changed(infoCTChange)
Definition: fstr_contact.f90:82
m_fstr_residual::fstr_update_ndforce_spc
subroutine, public fstr_update_ndforce_spc(cstep, hecMESH, fstrSOLID, B)
Definition: fstr_Residual.f90:98
mcontact::fstr_set_contact_penalty
subroutine fstr_set_contact_penalty(maxv)
Definition: fstr_contact.f90:45
m_fstr_residual::fstr_update_ndforce
subroutine, public fstr_update_ndforce(cstep, hecMESH, hecMAT, fstrSOLID, conMAT)
Definition: fstr_Residual.f90:25
mcontact::fstr_setup_parancon_contactvalue
subroutine fstr_setup_parancon_contactvalue(hecMESH, ndof, vec, vtype)
Definition: fstr_contact.f90:764
mcontact::fstr_is_contact_conv
logical function fstr_is_contact_conv(ctAlgo, infoCTChange, hecMESH)
Definition: fstr_contact.f90:61
m_fstr_nonlinearmethod::fstr_newton_contactalag
subroutine fstr_newton_contactalag(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, restart_step_num, restart_substep_num, sub_step, ctime, dtime, infoCTChange, conMAT)
This subroutine solve nonlinear solid mechanics problems by Newton-Raphson method combined with Neste...
Definition: fstr_solve_NonLinear.f90:134
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.f90:15
m_solve_lineq_contact::solve_lineq_contact
subroutine, public solve_lineq_contact(hecMESH, hecMAT, hecLagMAT, conMAT, istat, rf, is_contact_active)
This subroutine.
Definition: hecmw_solver_contact.f90:74
m_fstr_residual::fstr_get_norm_para_contact
real(kind=kreal) function, public fstr_get_norm_para_contact(hecMAT, hecLagMAT, conMAT, hecMESH)
Definition: fstr_Residual.f90:240
mcontact::fstr_is_contact_active
logical function fstr_is_contact_active()
Definition: fstr_contact.f90:52
m_fstr_update::fstr_updatenewton
subroutine fstr_updatenewton(hecMESH, hecMAT, fstrSOLID, time, tincr, iter, strainEnergy)
Update displacement, stress, strain and internal forces.
Definition: fstr_Update.f90:26
m_fstr::fstr_set_current_config_to_mesh
subroutine fstr_set_current_config_to_mesh(hecMESH, fstrSOLID, coord)
Definition: m_fstr.f90:1099
mcontact::fstr_ass_load_contactalag
subroutine fstr_ass_load_contactalag(hecMESH, fstrSOLID, B)
Update lagrangian multiplier.
Definition: fstr_contact.f90:447
m_fstr::kitrdiverged
integer(kind=kint), parameter kitrdiverged
Definition: m_fstr.f90:91
m_fstr_addbc::fstr_addbc
subroutine fstr_addbc(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, hecLagMAT, iter, conMAT, RHSvector)
Add Essential Boundary Conditions.
Definition: fstr_AddBC.f90:14
m_solve_lineq_contact::solve_lineq_contact_init
subroutine, public solve_lineq_contact_init(hecMESH, hecMAT, hecLagMAT, is_sym)
This subroutine.
Definition: hecmw_solver_contact.f90:30
m_fstr_ass_load::fstr_ass_load
subroutine fstr_ass_load(cstep, ctime, hecMESH, hecMAT, fstrSOLID, fstrPARAM)
This subroutine assmble following external force into fstrSOLIDGL and hecMATB afterwards.
Definition: fstr_ass_load.f90:19
m_addcontactstiffness::fstr_addcontactstiffness
subroutine, public fstr_addcontactstiffness(cstep, iter, hecMAT, hecLagMAT, fstrSOLID)
This subroutine obtains contact stiffness matrix of each contact pair and assembles it into global st...
Definition: fstr_AddContactStiff.f90:38
m_fstr::paracontactflag
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.f90:100
m_fstr_stiffmatrix
This module provides function to calculate tangent stiffness matrix.
Definition: fstr_StiffMatrix.f90:7
m_static_lib
This modules just summarizes all modules used in static analysis.
Definition: static_LIB.f90:6
m_fstr_nonlinearmethod::fstr_init_newton
subroutine fstr_init_newton(hecMESH, hecMAT, fstrSOLID, ctime, tincr, iter, cstep, dtime, fstrPARAM, hecLagMAT, ndof)
Definition: fstr_solve_NonLinear.f90:625
m_fstr_update::fstr_updatestate
subroutine fstr_updatestate(hecMESH, fstrSOLID, tincr)
Update elastiplastic status.
Definition: fstr_Update.f90:250
m_fstr_nonlinearmethod
This module provides functions on nonlinear analysis.
Definition: fstr_solve_NonLinear.f90:7
m_fstr_addbc
This module provides a function to deal with prescribed displacement.
Definition: fstr_AddBC.f90:7
m_fstr_spring
This module provides functions to deal with spring force.
Definition: fstr_Spring.f90:7
m_fstr_nonlinearmethod::fstr_check_iteration_converged
integer(kind=kint) function fstr_check_iteration_converged(hecMESH, hecMAT, fstrSOLID, ndof, iter, sub_step, cstep)
\breaf This function check iteration status
Definition: fstr_solve_NonLinear.f90:653
m_fstr_nonlinearmethod::fstr_newton
subroutine fstr_newton(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM, restrt_step_num, sub_step, ctime, dtime)
This subroutine solve nonlinear solid mechanics problems by Newton-Raphson method.
Definition: fstr_solve_NonLinear.f90:30
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:107
mcontact::fstr_update_contact_multiplier
subroutine fstr_update_contact_multiplier(hecMESH, fstrSOLID, ctchanged)
Update lagrangian multiplier.
Definition: fstr_contact.f90:418
mcontact::fstr_update_contact_tangentforce
subroutine fstr_update_contact_tangentforce(fstrSOLID)
Update tangent force.
Definition: fstr_contact.f90:469
m_fstr::fstr_recover_initial_config_to_mesh
subroutine fstr_recover_initial_config_to_mesh(hecMESH, fstrSOLID, coord)
Definition: m_fstr.f90:1112
m_fstr_restart
This module provides functions to read in and write out restart files.
Definition: fstr_Restart.f90:8
m_addcontactstiffness::fstr_ass_load_contact
subroutine, public fstr_ass_load_contact(cstep, hecMESH, hecMAT, fstrSOLID, hecLagMAT)
This subroutine adds initial contact force vector to the right-hand side vector \at the beginning of ...
Definition: fstr_AddContactStiff.f90:558
mcontact
This module provides functions to calculate contact stiff matrix.
Definition: fstr_contact.f90:6
m_fstr::imsg
integer(kind=kint), parameter imsg
Definition: m_fstr.f90:110