FrontISTR  6.0.0
Large-scale structural analysis program with finit element method
make_result.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 module m_make_result
7  private
8 
9  public:: fstr_write_result
10  public:: fstr_write_result_add
11  public:: fstr_make_result
12  public:: fstr_merge_result
13  public:: fstr_reorder_node_shell
14  public:: fstr_reorder_rot_shell
15  public:: fstr_reorder_rot_beam
16  public:: fstr_reorder_node_beam
17  public:: setup_contact_output_variables
18 
19 contains
20 
21  !C***
23  !C***
24  subroutine fstr_write_result( hecMESH, fstrSOLID, istep, time, flag, fstrDYNAMIC)
25  use m_fstr
26  use hecmw_util
27 
28  implicit none
29  type (hecmwst_local_mesh) :: hecmesh
30  type (fstr_solid) :: fstrsolid
31  integer(kind=kint) :: istep, flag
32  type (fstr_dynamic), intent(in), optional :: fstrdynamic
33  real(kind=kreal) :: time
34  integer(kind=kint) :: id
35  real(kind=kreal) :: work(1)
36  character(len=HECMW_HEADER_LEN) :: header
37  character(len=HECMW_MSG_LEN) :: comment
38  character(len=HECMW_NAME_LEN) :: label, nameid, addfname
39 
40  ! --- INITIALIZE
41  header = '*fstrresult'
42  if( present(fstrdynamic) ) then
43  comment = 'dynamic_result'
44  else
45  comment = 'static_result'
46  endif
47  call hecmw_result_init( hecmesh, istep, header, comment )
48 
49  ! --- TIME
50  id = hecmw_result_dtype_global
51  label = 'TOTALTIME'
52  work(1) = time
53  call hecmw_result_add( id, 1, label, work )
54 
55  if( present(fstrdynamic) ) then
56  call fstr_write_result_add( hecmesh, fstrsolid, istep, "", fstrdynamic )
57  else
58  call fstr_write_result_add( hecmesh, fstrsolid, istep, "" )
59  endif
60 
61  ! --- WRITE
62  nameid = 'fstrRES'
63  if( flag==0 ) then
64  call hecmw_result_write_by_name( nameid )
65  else
66  addfname = '_dif'
67  call hecmw_result_write_by_addfname( nameid, addfname )
68  endif
69 
70  ! --- FINALIZE
71  call hecmw_result_finalize
72  end subroutine fstr_write_result
73 
74  !C***
78  !C***
79  subroutine fstr_write_result_add( hecMESH, fstrSOLID, istep, label_suffix, fstrDYNAMIC)
80  use m_fstr
81  use m_out
82  use m_static_lib
83  use mmaterial
84  use hecmw_util
85 
86  implicit none
87  type (hecmwst_local_mesh) :: hecmesh
88  type (fstr_solid) :: fstrsolid
89  integer(kind=kint) :: istep
90  character(len=*) :: label_suffix
91  type (fstr_dynamic), intent(in), optional :: fstrdynamic
92  integer(kind=kint) :: ntot_lyr, is_33shell, is_33beam
93  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, nn, mm, ngauss
94  real(kind=kreal), pointer :: tnstrain(:), testrain(:), yield_ratio(:)
95  integer(kind=kint) :: idx
96  real(kind=kreal), allocatable :: work(:), unode(:), rnode(:)
97  character(len=HECMW_NAME_LEN) :: s, label, cnum
98  character(len=16), allocatable :: clyr(:)
99  logical :: is_dynamic
100 
101  tnstrain => fstrsolid%TNSTRAIN
102  testrain => fstrsolid%TESTRAIN
103  yield_ratio => fstrsolid%YIELD_RATIO
104 
105  is_dynamic = present(fstrdynamic)
106 
107  if( is_dynamic ) then
108  idx = 1
109  if( fstrdynamic%idx_eqa/=11 .and. istep>0 ) idx = 2
110  endif
111 
112  ndof = hecmesh%n_dof
113  mm = hecmesh%n_node
114  if( hecmesh%n_elem > hecmesh%n_node ) mm = hecmesh%n_elem
115  if( ndof==2 ) mdof = 3
116  if( ndof==3 ) mdof = 6
117  if( ndof==4 ) mdof = 6
118  if( ndof==6 ) mdof = 6
119 
120  ntot_lyr = fstrsolid%max_lyr
121  is_33shell = fstrsolid%is_33shell
122  is_33beam = fstrsolid%is_33beam
123 
124  nn = mm * mdof
125  allocate( work(nn) )
126 
127  ! --- DISPLACEMENT
128  if( fstrsolid%output_ctrl(3)%outinfo%on(1) ) then
129  if(ndof == 4) then
130  id = hecmw_result_dtype_node
131  ! for VELOCITY
132  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
133  allocate( unode(3*hecmesh%n_node) )
134  unode = 0.0d0
135  do i=1, hecmesh%n_node
136  do j = 1, 3
137  unode((i-1)*3 + j) = fstrdynamic%DISP((i-1)*4 + j, idx)
138  enddo
139  enddo
140  label = 'VELOCITY'
141  call result_add( id, nitem, label, label_suffix, unode )
142  deallocate( unode )
143  ! for PRESSURE
144  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 1 )
145  allocate( unode(hecmesh%n_node) )
146  unode = 0.0d0
147  do i=1, hecmesh%n_node
148  unode(i) = fstrdynamic%DISP(i*4, idx)
149  enddo
150  label = 'PRESSURE'
151  call result_add( id, nitem, label, label_suffix, unode )
152  deallocate( unode )
153  else if(ndof == 6) then
154  id = hecmw_result_dtype_node
155  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
156  allocate( unode(hecmesh%n_node*3) )
157  unode = 0.0d0
158  if( is_dynamic ) then
159  do i=1, hecmesh%n_node
160  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
161  enddo
162  else
163  do i=1, hecmesh%n_node
164  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
165  enddo
166  endif
167  label = 'DISPLACEMENT'
168  call result_add( id, nitem, label, label_suffix, unode )
169  deallocate( unode )
170  else
171  id = hecmw_result_dtype_node
172  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), ndof )
173  allocate( unode(hecmesh%n_node*ndof) )
174  unode = 0.0d0
175  if( is_dynamic ) then
176  unode(:) = fstrdynamic%DISP(:,idx)
177  else
178  unode(:) = fstrsolid%unode
179  endif
180  label = 'DISPLACEMENT'
181  if(is_33beam == 1)then
182  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
183  endif
184  if(is_33shell == 1)then
185  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
186  endif
187  call result_add( id, nitem, label, label_suffix, unode )
188  deallocate( unode )
189  endif
190  endif
191 
192  ! --- ROTATION
193  if (fstrsolid%output_ctrl(3)%outinfo%on(18)) then
194  if(ndof == 6) then
195  id = hecmw_result_dtype_node
196  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
197  label = 'ROTATION'
198  allocate( rnode(hecmesh%n_node*3) )
199  rnode = 0.0d0
200  if( is_dynamic ) then
201  do i=1, hecmesh%n_node
202  rnode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
203  enddo
204  else
205  do i=1, hecmesh%n_node
206  rnode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
207  enddo
208  endif
209  call result_add( id, nitem, label, label_suffix, rnode )
210  deallocate( rnode )
211  else
212  if ( is_33shell == 1 .or. is_33beam == 1 ) then
213  id = hecmw_result_dtype_node
214  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), ndof )
215  label = 'ROTATION'
216  allocate( rnode(hecmesh%n_node*ndof) )
217  rnode = 0.0d0
218  if( is_33shell == 1 ) call fstr_reorder_rot_shell(fstrsolid, hecmesh, rnode)
219  if( is_33beam == 1 ) call fstr_reorder_rot_beam(fstrsolid, hecmesh, rnode)
220  call result_add( id, nitem, label, label_suffix, rnode )
221  deallocate( rnode )
222  end if
223  end if
224  endif
225 
226  ! --- VELOCITY
227  if( is_dynamic .and. fstrsolid%output_ctrl(3)%outinfo%on(15) ) then
228  id = hecmw_result_dtype_node
229  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(15), ndof )
230  label = 'VELOCITY'
231  call result_add( id, nitem, label, label_suffix, fstrdynamic%VEL(:,idx) )
232  endif
233 
234  ! --- ACCELERATION
235  if( is_dynamic .and. fstrsolid%output_ctrl(3)%outinfo%on(16) ) then
236  id = hecmw_result_dtype_node
237  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(16), ndof )
238  label = 'ACCELERATION'
239  call result_add( id, nitem, label, label_suffix, fstrdynamic%ACC(:,idx) )
240  endif
241 
242  ! --- REACTION FORCE
243  if( fstrsolid%output_ctrl(3)%outinfo%on(2) ) then
244  id = hecmw_result_dtype_node
245  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(2), ndof )
246  label = 'REACTION_FORCE'
247  call result_add( id, nitem, label, label_suffix, fstrsolid%REACTION )
248  endif
249 
250  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
251 
252  if(is_33shell == 1 .or. ndof == 6)then
253  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL, " ", label_suffix )
254  else
255  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SOLID, " ", label_suffix )
256  endif
257 
258  !laminated shell
259  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(3)%outinfo%on(27) ) then
260  allocate(clyr(2*ntot_lyr))
261  do i=1,ntot_lyr
262  write(cnum,"(i0)")i
263  clyr(2*i-1)="_L"//trim(cnum)//"+"
264  clyr(2*i )="_L"//trim(cnum)//"-"
265  enddo
266  do i=1,ntot_lyr
267  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL%LAYER(i)%PLUS, clyr(2*i-1), label_suffix )
268  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL%LAYER(i)%MINUS, clyr(2*i ), label_suffix )
269  enddo
270  deallocate(clyr)
271  endif
272 
273  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
274  ngauss = fstrsolid%maxn_gauss
275  if( fstrsolid%output_ctrl(3)%outinfo%on(11) .or. &
276  (ndof/=6 .and. any(fstrsolid%output_ctrl(3)%outinfo%on(9:10))) ) then
277  do i = 1, hecmesh%n_elem
278  if( associated(fstrsolid%elements(i)%shell_layer_gausses) ) then
279  ngauss = max(ngauss, size(fstrsolid%elements(i)%shell_layer_gausses))
280  endif
281  enddo
282  call hecmw_allreduce_i1(hecmesh, ngauss, hecmw_max)
283  endif
284  if( ndof==6 ) call fstr_write_shell_gauss_result(hecmesh, fstrsolid, label_suffix)
285 
286  ! --- STRAIN @gauss
287  if( fstrsolid%output_ctrl(3)%outinfo%on(9) .and. ndof/=6 ) then
288  id = hecmw_result_dtype_elem
289  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(9), ndof )
290  work(:) = 0.d0
291  do k = 1, ngauss
292  ! Preserve legacy solid slots; clear shell padding per element below.
293  if( k>fstrsolid%maxn_gauss ) work(:) = 0.d0
294  write(s,*) k
295  write(label,'(a,a)') 'GaussSTRAIN',trim(adjustl(s))
296  label = adjustl(label)
297  do i = 1, hecmesh%n_elem
298  if( associated(fstrsolid%elements(i)%shell_layer_gausses) ) then
299  work(nitem*(i-1)+1:nitem*i) = 0.d0
300  if( k <= size(fstrsolid%elements(i)%shell_layer_gausses) ) then
301  work(nitem*(i-1)+1:nitem*i) = fstrsolid%elements(i)%shell_layer_gausses(k)%strain_out(1:nitem)
302  endif
303  else if( associated(fstrsolid%elements(i)%gausses) ) then
304  if( k <= size(fstrsolid%elements(i)%gausses) ) then
305  do j = 1, nitem
306  work(nitem*(i-1)+j) = fstrsolid%elements(i)%gausses(k)%strain_out(j)
307  enddo
308  endif
309  end if
310  enddo
311  call result_add( id, nitem, label, label_suffix, work )
312  enddo
313  endif
314 
315  ! --- STRESS @gauss
316  if( fstrsolid%output_ctrl(3)%outinfo%on(10) .and. ndof/=6 ) then
317  id = hecmw_result_dtype_elem
318  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(10), ndof )
319  work(:) = 0.d0
320  do k = 1, ngauss
321  if( k>fstrsolid%maxn_gauss ) work(:) = 0.d0
322  write(s,*) k
323  write(label,'(a,a)') 'GaussSTRESS',trim(adjustl(s))
324  label = adjustl(label)
325  do i = 1, hecmesh%n_elem
326  if( associated(fstrsolid%elements(i)%shell_layer_gausses) ) then
327  work(nitem*(i-1)+1:nitem*i) = 0.d0
328  if( k <= size(fstrsolid%elements(i)%shell_layer_gausses) ) then
329  work(nitem*(i-1)+1:nitem*i) = fstrsolid%elements(i)%shell_layer_gausses(k)%stress_out(1:nitem)
330  endif
331  else if( associated(fstrsolid%elements(i)%gausses) ) then
332  if( k <= size(fstrsolid%elements(i)%gausses) ) then
333  do j = 1, nitem
334  work(nitem*(i-1)+j) = fstrsolid%elements(i)%gausses(k)%stress_out(j)
335  enddo
336  endif
337  end if
338  enddo
339  call result_add( id, nitem, label, label_suffix, work )
340  enddo
341  endif
342 
343  ! --- PLASTIC STRAIN @gauss
344  if( fstrsolid%output_ctrl(3)%outinfo%on(11) .and. fstrsolid%StaticType/=3 ) then
345  id = hecmw_result_dtype_elem
346  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(11), ndof )
347  work(:) = 0.d0
348  do k = 1, ngauss
349  if( k>fstrsolid%maxn_gauss ) work(:) = 0.d0
350  write(s,*) k
351  write(label,'(a,a)') 'PLASTIC_GaussSTRAIN',trim(adjustl(s))
352  label = adjustl(label)
353  do i = 1, hecmesh%n_elem
354  ! Shell histories are ordered by surface point, layer, then thickness point.
355  if( associated(fstrsolid%elements(i)%shell_layer_gausses) ) then
356  work(i) = 0.d0
357  if( k <= size(fstrsolid%elements(i)%shell_layer_gausses) ) then
358  work(i) = fstrsolid%elements(i)%shell_layer_gausses(k)%plstrain
359  endif
360  else if( associated(fstrsolid%elements(i)%gausses) ) then
361  if( k <= size(fstrsolid%elements(i)%gausses) ) then
362  work(i) = fstrsolid%elements(i)%gausses(k)%plstrain
363  endif
364  endif
365  enddo
366  call result_add( id, nitem, label, label_suffix, work )
367  enddo
368  endif
369 
370  ! --- THERMAL STRAIN @node
371  if( fstrsolid%output_ctrl(3)%outinfo%on(12) .and. associated(tnstrain) ) then
372  id = hecmw_result_dtype_node
373  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(12), ndof )
374  label = 'THERMAL_NodalSTRAIN'
375  call result_add( id, nitem, label, label_suffix, tnstrain )
376  endif
377 
378  ! --- THERMAL STRAIN @element
379  if( fstrsolid%output_ctrl(3)%outinfo%on(13) .and. associated(testrain) ) then
380  id = hecmw_result_dtype_elem
381  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(13), ndof )
382  label = 'THERMAL_ElementalSTRAIN'
383  call result_add( id, nitem, label, label_suffix, testrain )
384  endif
385 
386  ! --- THERMAL STRAIN @gauss
387  if( fstrsolid%output_ctrl(3)%outinfo%on(14) .and. associated(testrain) ) then
388  id = hecmw_result_dtype_elem
389  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(14), ndof )
390  ngauss = fstrsolid%maxn_gauss
391  do k = 1, ngauss
392  write(s,*) k
393  write(label,'(a,a)') 'THERMAL_GaussSTRAIN',trim(adjustl(s))
394  label = adjustl(label)
395  do i = 1, hecmesh%n_elem
396  if( k > ngauss ) then
397  do j = 1, nitem
398  work(nitem*(i-1)+j) = 0.d0
399  enddo
400  else
401  do j = 1, nitem
402  ! work(nitem*(i-1)+j) = fstrSOLID%elements(i)%gausses(k)%tstrain(j)
403  enddo
404  end if
405  enddo
406  call result_add( id, nitem, label, label_suffix, work )
407  enddo
408  endif
409 
410  ! --- YIELD RATIO
411  if( fstrsolid%output_ctrl(3)%outinfo%on(29) ) then
412  id = hecmw_result_dtype_elem
413  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(29), ndof )
414  label = "YIELD_RATIO"
415  call result_add( id, nitem, label, label_suffix, yield_ratio )
416  endif
417 
418  ! --- CONTACT NORMAL FORCE @node
419  if( fstrsolid%output_ctrl(3)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
420  id = hecmw_result_dtype_node
421  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(30), ndof )
422  label = 'CONTACT_NFORCE'
423  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_NFORCE )
424  endif
425 
426  ! --- CONTACT FRICTION FORCE @node
427  if( fstrsolid%output_ctrl(3)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
428  id = hecmw_result_dtype_node
429  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(31), ndof )
430  label = 'CONTACT_FRICTION'
431  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_FRIC )
432  endif
433 
434  ! --- CONTACT RELATIVE VELOCITY @node
435  if( fstrsolid%output_ctrl(3)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
436  id = hecmw_result_dtype_node
437  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(32), ndof )
438  label = 'CONTACT_RELVEL'
439  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_RELVEL )
440  endif
441 
442  ! --- CONTACT STATE @node
443  if( fstrsolid%output_ctrl(3)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
444  id = hecmw_result_dtype_node
445  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(33), ndof )
446  label = 'CONTACT_STATE'
447  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_STATE )
448  endif
449 
450  ! --- CONTACT NORMAL TRACTION @node
451  if( fstrsolid%output_ctrl(3)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
452  id = hecmw_result_dtype_node
453  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(36), ndof )
454  label = 'CONTACT_NTRACTION'
455  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_NTRAC )
456  endif
457 
458  ! --- CONTACT FRICTION TRACTION @node
459  if( fstrsolid%output_ctrl(3)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
460  id = hecmw_result_dtype_node
461  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(37), ndof )
462  label = 'CONTACT_FTRACTION'
463  call result_add( id, nitem, label, label_suffix, fstrsolid%CONT_FTRAC )
464  endif
465 
466  ! --- TEMPERATURE @node
467  !if(present(fstrPARAM))then
468  ! if( fstrSOLID%output_ctrl(4)%outinfo%on(38) .and. fstrPARAM%solution_type == kstHEATSTATIC)then
469  ! ncomp = ncomp + 1
470  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(38), ndof )
471  ! fstrRESULT%nn_dof(ncomp) = nn
472  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
473  ! do i = 1, hecMESH%n_node
474  ! do j = 1, nn
475  ! fstrRESULT%node_val_item(nitem*(i-1)+j+iitem) = fstrSOLID%temperature(nn*(i-1)+j)
476  ! enddo
477  ! enddo
478  ! iitem = iitem + nn
479  ! endif
480  !endif
481 
482  ! --- ELEMACT flag @element
483  if( fstrsolid%output_ctrl(3)%outinfo%on(44) ) then
484  id = hecmw_result_dtype_elem
485  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(44), ndof )
486  label = 'ELEMACT'
487  work(:) = 0.d0
488  do i = 1, hecmesh%n_elem
489  if( fstrsolid%elements(i)%elemact_flag /= kelact_inactive ) work(i) = 1.d0
490  enddo
491  call result_add( id, nitem, label, label_suffix, work )
492  endif
493 
494  deallocate( work )
495  end subroutine fstr_write_result_add
496 
498  subroutine fstr_write_shell_gauss_result(hecMESH, fstrSOLID, label_suffix)
499  use m_fstr
500  use mmechgauss, only: fstr_shell_output_point_count
501  use m_fstr_nodalstress, only: fstr_get_shell_gauss_output
502  implicit none
503  type(hecmwst_local_mesh), intent(in) :: hecMESH
504  type(fstr_solid), intent(inout) :: fstrSOLID
505  character(len=*), intent(in) :: label_suffix
506  integer(kind=kint) :: i, k, ngauss, nfield
507  real(kind=kreal) :: strain(6), stress(6)
508  real(kind=kreal), allocatable :: values(:,:)
509  character(len=HECMW_NAME_LEN) :: label
510 
511  nfield = count(fstrsolid%output_ctrl(3)%outinfo%on(9:10))
512  if( nfield==0 ) return
513  ngauss = 0
514  do i=1,hecmesh%n_elem
515  ngauss = max(ngauss, fstr_shell_output_point_count(fstrsolid%elements(i)))
516  enddo
517  call hecmw_allreduce_i1(hecmesh, ngauss, hecmw_max)
518  allocate(values(6*hecmesh%n_elem,nfield))
519  do k=1,ngauss
520  do i=1,hecmesh%n_elem
521  call fstr_get_shell_gauss_output(hecmesh, fstrsolid, i, k, strain, stress)
522  if( fstrsolid%output_ctrl(3)%outinfo%on(9) ) values(6*i-5:6*i,1) = strain
523  if( fstrsolid%output_ctrl(3)%outinfo%on(10) ) values(6*i-5:6*i,nfield) = stress
524  enddo
525  if( fstrsolid%output_ctrl(3)%outinfo%on(9) ) then
526  write(label,'(a,i0)') 'GaussSTRAIN',k
527  call result_add(hecmw_result_dtype_elem, 6, label, label_suffix, values(:,1))
528  endif
529  if( fstrsolid%output_ctrl(3)%outinfo%on(10) ) then
530  write(label,'(a,i0)') 'GaussSTRESS',k
531  call result_add(hecmw_result_dtype_elem, 6, label, label_suffix, values(:,nfield))
532  endif
533  enddo
534  deallocate(values)
535  end subroutine fstr_write_shell_gauss_result
536 
537  subroutine result_add( dtype, n_dof, label, label_suffix, data )
538  use m_fstr
539  use hecmw_util
540 
541  implicit none
542  integer(kind=kint), intent(in) :: dtype
543  integer(kind=kint), intent(in) :: n_dof
544  character(len=*), intent(in) :: label
545  character(len=*), intent(in) :: label_suffix
546  real(kind=kreal) :: data(:)
547  character(len=HECMW_NAME_LEN) :: name
548 
549  name = trim(label)//trim(label_suffix)
550  call hecmw_result_add( dtype, n_dof, name, data )
551  end subroutine result_add
552 
553  subroutine fstr_write_result_main( hecMESH, fstrSOLID, RES, clyr, label_suffix )
554  use m_fstr
555  use m_out
556  use m_static_lib
557  use mmaterial
558  use hecmw_util
559 
560  implicit none
561  type (hecmwST_local_mesh) :: hecMESH
562  type (fstr_solid) :: fstrSOLID
563  type (fstr_solid_physic_val) :: RES
564 
565  character(len=HECMW_NAME_LEN) :: label
566  character(len=16) :: clyr
567  character(len=*) :: label_suffix
568  character(len=12) :: cnum
569  integer(kind=kint) :: k, ndof, id, nitem
570  real(kind=kreal), allocatable :: work(:)
571 
572  ndof = hecmesh%n_dof
573  allocate( work(hecmesh%n_elem) )
574 
575  ! --- STRAIN @node
576  if (fstrsolid%output_ctrl(3)%outinfo%on(3)) then
577  id = hecmw_result_dtype_node
578  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(3), ndof )
579  label = 'NodalSTRAIN'//trim(clyr)
580  call result_add( id, nitem, label, label_suffix, res%STRAIN )
581  endif
582 
583  ! --- STRESS @node
584  if( fstrsolid%output_ctrl(3)%outinfo%on(4) ) then
585  id = hecmw_result_dtype_node
586  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(4), ndof )
587  label = 'NodalSTRESS'//trim(clyr)
588  call result_add( id, nitem, label, label_suffix, res%STRESS )
589  endif
590 
591  ! --- MISES @node
592  if( fstrsolid%output_ctrl(3)%outinfo%on(5) ) then
593  id = hecmw_result_dtype_node
594  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(5), ndof )
595  label = 'NodalMISES'//trim(clyr)
596  call result_add( id, nitem, label, label_suffix, res%MISES )
597  endif
598 
599  ! --- NODAL PRINC STRESS
600  if( fstrsolid%output_ctrl(3)%outinfo%on(19) ) then
601  id = hecmw_result_dtype_node
602  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(19), ndof )
603  label = 'NodalPrincipalSTRESS'//trim(clyr)
604  call result_add( id, nitem, label, label_suffix, res%PSTRESS )
605  endif
606 
607  ! --- NODAL PRINC STRAIN
608  if( fstrsolid%output_ctrl(3)%outinfo%on(21) ) then
609  id = hecmw_result_dtype_node
610  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(21), ndof )
611  label = 'NodalPrincipalSTRAIN'//trim(clyr)
612  call result_add( id, nitem, label, label_suffix, res%PSTRAIN )
613  endif
614 
615  ! --- NODAL PRINC STRESS VECTOR
616  if( fstrsolid%output_ctrl(3)%outinfo%on(23) ) then
617  id = hecmw_result_dtype_node
618  do k=1,3
619  write(cnum,'(i0)')k
620  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(23), ndof )
621  label = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
622  call result_add( id, nitem, label, label_suffix, res%PSTRESS_VECT(:,k) )
623  end do
624  endif
625 
626  ! --- NODAL PRINC STRAIN VECTOR
627  if( fstrsolid%output_ctrl(3)%outinfo%on(25) ) then
628  id = hecmw_result_dtype_node
629  do k=1,3
630  write(cnum,'(i0)')k
631  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(25), ndof )
632  label = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
633  call result_add( id, nitem, label, label_suffix, res%PSTRAIN_VECT(:,k) )
634  end do
635  endif
636 
637  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
638  ! --- STRAIN @element
639  if( fstrsolid%output_ctrl(3)%outinfo%on(6) ) then
640  id = hecmw_result_dtype_elem
641  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(6), ndof )
642  label = 'ElementalSTRAIN'//trim(clyr)
643  call result_add( id, nitem, label, label_suffix, res%ESTRAIN )
644  endif
645 
646  ! --- STRESS @element
647  if( fstrsolid%output_ctrl(3)%outinfo%on(7) ) then
648  id = hecmw_result_dtype_elem
649  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(7), ndof )
650  label = 'ElementalSTRESS'//trim(clyr)
651  call result_add( id, nitem, label, label_suffix, res%ESTRESS )
652  endif
653 
654  ! --- NQM @element
655  if( fstrsolid%output_ctrl(3)%outinfo%on(35) ) then
656  id = hecmw_result_dtype_elem
657  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(35), ndof )
658  label = 'ElementalNQM'//trim(clyr)
659  call result_add( id, nitem, label, label_suffix, res%ENQM )
660  endif
661 
662  ! --- MISES @element
663  if( fstrsolid%output_ctrl(3)%outinfo%on(8)) then
664  id = hecmw_result_dtype_elem
665  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(8), ndof )
666  label = 'ElementalMISES'//trim(clyr)
667  call result_add( id, nitem, label, label_suffix, res%EMISES )
668  endif
669 
670  ! --- Principal_STRESS @element
671  if( fstrsolid%output_ctrl(3)%outinfo%on(20) ) then
672  id = hecmw_result_dtype_elem
673  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(20), ndof )
674  label = 'ElementalPrincipalSTRESS'//trim(clyr)
675  call result_add( id, nitem, label, label_suffix, res%EPSTRESS )
676  endif
677 
678  ! --- Principal_STRAIN @element
679  if( fstrsolid%output_ctrl(3)%outinfo%on(22) ) then
680  id = hecmw_result_dtype_elem
681  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(22), ndof )
682  label = 'ElementalPrincipalSTRAIN'//trim(clyr)
683  call result_add( id, nitem, label, label_suffix, res%EPSTRAIN )
684  endif
685 
686  ! --- ELEM PRINC STRESS VECTOR
687  if( fstrsolid%output_ctrl(3)%outinfo%on(24) ) then
688  id = hecmw_result_dtype_elem
689  do k=1,3
690  write(cnum,'(i0)')k
691  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(24), ndof )
692  label = 'ElementalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
693  call result_add( id, nitem, label, label_suffix, res%EPSTRESS_VECT(:,k) )
694  end do
695  endif
696 
697  !ELEM PRINC STRAIN VECTOR
698  if( fstrsolid%output_ctrl(3)%outinfo%on(26) ) then
699  id = hecmw_result_dtype_elem
700  do k=1,3
701  write(cnum,'(i0)')k
702  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(26), ndof )
703  label = 'ElementalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
704  call result_add( id, nitem, label, label_suffix, res%EPSTRAIN_VECT(:,k) )
705  end do
706  endif
707 
708  ! --- PLASTIC STRAIN @element
709  if( fstrsolid%output_ctrl(3)%outinfo%on(43) ) then
710  id = hecmw_result_dtype_elem
711  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(43), ndof )
712  label = 'ElementalPLSTRAIN'//trim(clyr)
713  call result_add( id, nitem, label, label_suffix, res%EPLSTRAIN )
714  endif
715  deallocate( work )
716 
717  end subroutine fstr_write_result_main
718 
719  !C***
721  !C***
722  subroutine fstr_make_result( hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC, label_suffix )
723  use m_fstr
724  use mmechgauss, only: fstr_element_average_plstrain
725  use hecmw_util
726 
727  implicit none
728  character(len=*), intent(in), optional :: label_suffix
729  type (hecmwst_local_mesh) :: hecmesh
730  type (fstr_solid) :: fstrsolid
731  type(hecmwst_result_data) :: fstrresult
732  integer(kind=kint) :: istep
733  real(kind=kreal) :: time
734  type(fstr_dynamic), intent(in), optional :: fstrdynamic
735  integer(kind=kint) :: ntot_lyr, coef33, is_33shell, is_33beam
736  integer(kind=kint) :: i, j, ndof, mdof, gcomp, gitem, ncomp, nitem, iitem, ecomp, eitem, jitem, nn, mm
737  integer(kind=kint) :: idx
738  real(kind=kreal), pointer :: tnstrain(:), testrain(:)
739  real(kind=kreal), allocatable ::unode(:)
740  character(len=12) :: cnum
741  character(len=16), allocatable :: clyr(:)
742  logical :: is_dynamic
743 
744  is_dynamic = present(fstrdynamic)
745 
746  tnstrain => fstrsolid%TNSTRAIN
747  testrain => fstrsolid%TESTRAIN
748 
749  ntot_lyr = fstrsolid%max_lyr
750  is_33shell = fstrsolid%is_33shell
751  is_33beam = fstrsolid%is_33beam
752 
753  mm = hecmesh%n_node
754  if( hecmesh%n_elem>hecmesh%n_node ) mm = hecmesh%n_elem
755 
756  if( is_dynamic ) then
757  idx = 1
758  if( fstrdynamic%idx_eqa/=11 .and. istep>0 ) idx = 2
759  endif
760 
761  ndof = hecmesh%n_dof
762  if( ndof==2 ) mdof = 3
763  if( ndof==3 ) mdof = 6
764  if( ndof==4 ) mdof = 6
765  if( ndof==6 ) mdof = 6
766 
767  if(is_33shell == 1 .and. fstrsolid%output_ctrl(4)%outinfo%on(27) )then
768  coef33 = 1 + 2*ntot_lyr
769  else
770  coef33 = 1
771  endif
772 
773  call hecmw_nullify_result_data( fstrresult )
774  gcomp = 0
775  gitem = 0
776  ncomp = 0
777  nitem = 0
778  ecomp = 0
779  eitem = 0
780 
781  ! --- COUNT SUM OF ALL NITEM
782  ! --- TIME
783  gcomp = gcomp + 1
784  gitem = gitem + 1
785  ! --- DISPLACEMENT
786  if( fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
787  if(ndof == 4) then
788  ncomp = ncomp + 1
789  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
790  ncomp = ncomp + 1
791  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
792  else if(ndof == 6) then
793  ncomp = ncomp + 1
794  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
795  else
796  ncomp = ncomp + 1
797  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
798  endif
799  endif
800  ! --- VELOCITY
801  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
802  ncomp = ncomp + 1
803  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
804  endif
805  ! --- ACCELERATION
806  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
807  ncomp = ncomp + 1
808  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
809  endif
810  ! --- TEMPERATURE @node
811  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature) ) then
812  ncomp = ncomp + 1
813  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
814  endif
815  ! --- ROTATION (6-DOF nodes, or the rotation nodes of 761/781 shells and 641 beams)
816  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
817  if(ndof == 6) then
818  ncomp = ncomp + 1
819  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), 3 )
820  else
821  if( is_33shell == 1 .or. is_33beam == 1 ) then
822  ncomp = ncomp + 1
823  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), ndof )
824  endif
825  endif
826  endif
827  ! --- REACTION FORCE
828  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
829  ncomp = ncomp + 1
830  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
831  endif
832  ! --- STRAIN @node
833  if( fstrsolid%output_ctrl(4)%outinfo%on(3) ) then
834  ncomp = ncomp + 1*coef33
835  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )*coef33
836  endif
837  ! --- STRESS @node
838  if( fstrsolid%output_ctrl(4)%outinfo%on(4) ) then
839  ncomp = ncomp + 1*coef33
840  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )*coef33
841  endif
842  ! --- MISES @node
843  if( fstrsolid%output_ctrl(4)%outinfo%on(5) ) then
844  ncomp = ncomp + 1*coef33
845  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )*coef33
846  endif
847  ! --- Principal Stress @node
848  if( fstrsolid%output_ctrl(4)%outinfo%on(19) ) then
849  ncomp = ncomp + 1*coef33
850  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )*coef33
851  endif
852  ! --- Principal Strain @node
853  if( fstrsolid%output_ctrl(4)%outinfo%on(21) ) then
854  ncomp = ncomp + 1*coef33
855  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )*coef33
856  endif
857  ! --- Principal Stress Vector @node
858  if( fstrsolid%output_ctrl(4)%outinfo%on(23) ) then
859  ncomp = ncomp + 3*coef33
860  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )*coef33
861  endif
862  ! --- Principal Strain Vector @node
863  if( fstrsolid%output_ctrl(4)%outinfo%on(25) ) then
864  ncomp = ncomp + 3*coef33
865  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )*coef33
866  endif
867  ! --- THERMAL STRAIN @node
868  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
869  ncomp = ncomp + 1
870  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
871  endif
872  ! --- CONTACT NORMAL FORCE @node
873  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
874  ncomp = ncomp + 1
875  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
876  endif
877  ! --- CONTACT FRICTION FORCE @node
878  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
879  ncomp = ncomp + 1
880  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
881  endif
882  ! --- CONTACT RELATIVE VELOCITY @node
883  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
884  ncomp = ncomp + 1
885  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
886  endif
887  ! --- CONTACT STATE @node
888  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
889  ncomp = ncomp + 1
890  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
891  endif
892  ! --- CONTACT NORMAL TRACTION @node
893  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
894  ncomp = ncomp + 1
895  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
896  endif
897  ! --- CONTACT FRICTION TRACTION @node
898  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
899  ncomp = ncomp + 1
900  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
901  endif
902  ! --- NODE ID @node
903  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
904  ncomp = ncomp + 1
905  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
906  endif
907  ! --- TEMPERATURE @node
908  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
909  ! ncomp = ncomp + 1
910  ! nitem = nitem + n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
911  !endif
912 
913  ! --- STRAIN @element
914  if( fstrsolid%output_ctrl(4)%outinfo%on(6) ) then
915  ecomp = ecomp + 1
916  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
917  endif
918  ! --- STRESS @element
919  if( fstrsolid%output_ctrl(4)%outinfo%on(7) ) then
920  ecomp = ecomp + 1
921  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
922  endif
923  ! --- MISES @element
924  if( fstrsolid%output_ctrl(4)%outinfo%on(8) ) then
925  ecomp = ecomp + 1
926  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
927  endif
928  ! --- Principal Stress @element
929  if( fstrsolid%output_ctrl(4)%outinfo%on(20) ) then
930  ecomp = ecomp + 1
931  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
932  endif
933  ! --- Principal Strain @element
934  if( fstrsolid%output_ctrl(4)%outinfo%on(22) ) then
935  ecomp = ecomp + 1
936  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
937  endif
938  ! --- Principal Stress Vector @element
939  if( fstrsolid%output_ctrl(4)%outinfo%on(24) ) then
940  ecomp = ecomp + 3
941  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
942  endif
943  ! --- Principal Strain Vector @element
944  if( fstrsolid%output_ctrl(4)%outinfo%on(26) ) then
945  ecomp = ecomp + 3
946  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
947  endif
948  ! --- PLASTIC STRAIN @element
949  if( fstrsolid%output_ctrl(4)%outinfo%on(43) ) then
950  ecomp = ecomp + 1
951  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
952  endif
953  ! --- MATERIAL @element
954  if( fstrsolid%output_ctrl(4)%outinfo%on(34) ) then
955  ecomp = ecomp + 1
956  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
957  endif
958  ! --- ORIENTATION @element
959  if( fstrsolid%output_ctrl(4)%outinfo%on(42) ) then
960  ecomp = ecomp + 3*coef33
961  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(42), ndof )*coef33
962  endif
963  ! --- ELEM ID @element
964  if( fstrsolid%output_ctrl(4)%outinfo%on(39) ) then
965  ecomp = ecomp + 1
966  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
967  endif
968  ! --- SECTION ID @element
969  if( fstrsolid%output_ctrl(4)%outinfo%on(40) ) then
970  ecomp = ecomp + 1
971  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
972  endif
973  ! --- ELEMACT flag @element
974  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
975  ecomp = ecomp + 1
976  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
977  endif
978 
979  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
980  fstrresult%ng_component = gcomp
981  fstrresult%nn_component = ncomp
982  fstrresult%ne_component = ecomp
983  allocate( fstrresult%ng_dof(gcomp) )
984  allocate( fstrresult%global_label(gcomp) )
985  allocate( fstrresult%global_val_item(gitem) )
986  allocate( fstrresult%nn_dof(ncomp) )
987  allocate( fstrresult%node_label(ncomp) )
988  allocate( fstrresult%node_val_item(nitem*hecmesh%n_node) )
989  allocate( fstrresult%ne_dof(ecomp) )
990  allocate( fstrresult%elem_label(ecomp) )
991  allocate( fstrresult%elem_val_item(eitem*hecmesh%n_elem) )
992  ncomp = 0
993  iitem = 0
994  ecomp = 0
995  jitem = 0
996 
997  ! --- TIME
998  fstrresult%ng_dof(1) = 1
999  fstrresult%global_label(1) = "TOTALTIME"
1000  fstrresult%global_val_item(1) = time
1001 
1002  ! --- DISPLACEMENT
1003  if (fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
1004  if(ndof == 4) then
1005  ! DIPLACEMENT
1006  ncomp = ncomp + 1
1007  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
1008  fstrresult%nn_dof(ncomp) = nn
1009  fstrresult%node_label(ncomp) = 'VELOCITY'
1010  do i = 1, hecmesh%n_node
1011  do j = 1, 3
1012  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%DISP(4*(i-1)+j,idx)
1013  enddo
1014  enddo
1015  iitem = iitem + nn
1016  ! PRESSURE
1017  ncomp = ncomp + 1
1018  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
1019  fstrresult%nn_dof(ncomp) = nn
1020  fstrresult%node_label(ncomp) = 'PRESSURE'
1021  do i = 1, hecmesh%n_node
1022  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = fstrdynamic%DISP(4*i,idx)
1023  enddo
1024  iitem = iitem + nn
1025  else if(ndof == 6) then
1026  ncomp = ncomp + 1
1027  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
1028  fstrresult%nn_dof(ncomp) = nn
1029  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
1030  allocate( unode(3*hecmesh%n_node) )
1031  unode = 0.0d0
1032  if( is_dynamic ) then
1033  do i=1, hecmesh%n_node
1034  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
1035  enddo
1036  else
1037  do i=1, hecmesh%n_node
1038  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
1039  enddo
1040  endif
1041  do i = 1, hecmesh%n_node
1042  do j = 1, nn
1043  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1044  enddo
1045  enddo
1046  deallocate( unode )
1047  iitem = iitem + nn
1048 
1049  else
1050  ncomp = ncomp + 1
1051  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
1052  fstrresult%nn_dof(ncomp) = nn
1053  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
1054  allocate( unode(ndof*hecmesh%n_node) )
1055  unode = 0.0d0
1056  if( is_dynamic ) then
1057  unode(:) = fstrdynamic%DISP(:,idx)
1058  else
1059  unode(:) = fstrsolid%unode(:)
1060  endif
1061  if(is_33beam == 1)then
1062  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
1063  endif
1064  if(is_33shell == 1)then
1065  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
1066  endif
1067  do i = 1, hecmesh%n_node
1068  do j = 1, nn
1069  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1070  enddo
1071  enddo
1072  deallocate( unode )
1073  iitem = iitem + nn
1074  endif
1075  endif
1076 
1077  ! --- VELOCITY
1078  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
1079  ncomp = ncomp + 1
1080  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
1081  fstrresult%nn_dof(ncomp) = nn
1082  fstrresult%node_label(ncomp) = 'VELOCITY'
1083  do i = 1, hecmesh%n_node
1084  do j = 1, nn
1085  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%VEL(nn*(i-1)+j,idx)
1086  enddo
1087  enddo
1088  iitem = iitem + nn
1089  endif
1090 
1091  ! --- ACCELERATION
1092  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
1093  ncomp = ncomp + 1
1094  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
1095  fstrresult%nn_dof(ncomp) = nn
1096  fstrresult%node_label(ncomp) = 'ACCELERATION'
1097  do i = 1, hecmesh%n_node
1098  do j = 1, nn
1099  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%ACC(nn*(i-1)+j,idx)
1100  enddo
1101  enddo
1102  iitem = iitem + nn
1103  endif
1104 
1105  ! --- TEMPERATURE
1106  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature))then
1107  ncomp = ncomp + 1
1108  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
1109  fstrresult%nn_dof(ncomp) = nn
1110  fstrresult%node_label(ncomp) = 'TEMPERATURE'
1111  do i = 1, hecmesh%n_node
1112  do j = 1, nn
1113  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%temperature(nn*(i-1)+j)
1114  enddo
1115  enddo
1116  iitem = iitem + nn
1117  endif
1118 
1119  ! --- ROTATION
1120  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
1121 
1122  if(ndof == 6) then
1123  ncomp = ncomp + 1
1124  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
1125  fstrresult%nn_dof(ncomp) = nn
1126  fstrresult%node_label(ncomp) = 'ROTATION'
1127  allocate( unode(3*hecmesh%n_node) )
1128  unode = 0.0d0
1129  if( is_dynamic ) then
1130  do i=1, hecmesh%n_node
1131  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
1132  enddo
1133  else
1134  do i=1, hecmesh%n_node
1135  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
1136  enddo
1137  endif
1138  do i = 1, hecmesh%n_node
1139  do j = 1, nn
1140  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1141  enddo
1142  enddo
1143  deallocate( unode )
1144  iitem = iitem + nn
1145  else
1146  if ( is_33shell == 1 .or. is_33beam == 1 ) then
1147  ncomp = ncomp + 1
1148  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
1149  fstrresult%nn_dof(ncomp) = nn
1150  fstrresult%node_label(ncomp) = 'ROTATION'
1151  allocate( unode(ndof*hecmesh%n_node) )
1152  unode = 0.0d0
1153  if( is_33shell == 1 ) call fstr_reorder_rot_shell(fstrsolid, hecmesh, unode)
1154  if( is_33beam == 1 ) call fstr_reorder_rot_beam(fstrsolid, hecmesh, unode)
1155  do i = 1, hecmesh%n_node
1156  do j = 1, nn
1157  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1158  enddo
1159  enddo
1160  deallocate( unode )
1161  iitem = iitem + nn
1162  end if
1163  end if
1164  endif
1165 
1166  ! --- REACTION FORCE
1167  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
1168  ncomp = ncomp + 1
1169  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
1170  fstrresult%nn_dof(ncomp) = nn
1171  fstrresult%node_label(ncomp) = 'REACTION_FORCE'
1172  do i = 1, hecmesh%n_node
1173  do j = 1, nn
1174  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%REACTION(nn*(i-1)+j)
1175  enddo
1176  enddo
1177  iitem = iitem + nn
1178  endif
1179  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1180  if(is_33shell == 1 .or. ndof == 6)then
1181  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1182  & fstrsolid%SHELL, nitem, iitem, ncomp, eitem, jitem, ecomp, " " )
1183  else
1184  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1185  & fstrsolid%SOLID, nitem, iitem, ncomp, eitem, jitem, ecomp, " " )
1186  endif
1187 
1188  !laminated shell
1189  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(4)%outinfo%on(27) .and. is_33shell == 1 ) then
1190  allocate(clyr(2*ntot_lyr))
1191  do i=1,ntot_lyr
1192  write(cnum,"(i0)")i
1193  clyr(2*i-1)="_L"//trim(cnum)//"+"
1194  clyr(2*i )="_L"//trim(cnum)//"-"
1195  enddo
1196  do i=1,ntot_lyr
1197  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1198  & fstrsolid%SHELL%LAYER(i)%PLUS, nitem, iitem, ncomp, eitem, jitem, ecomp, clyr(2*i-1) )
1199  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1200  & fstrsolid%SHELL%LAYER(i)%MINUS, nitem, iitem, ncomp, eitem, jitem, ecomp, clyr(2*i ) )
1201  enddo
1202  deallocate(clyr)
1203  endif
1204 
1205  ! --- THERMAL STRAIN @node
1206  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
1207  ncomp = ncomp + 1
1208  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
1209  fstrresult%nn_dof(ncomp) = nn
1210  fstrresult%node_label(ncomp) = 'THERMAL_NodalSTRAIN'
1211  do i = 1, hecmesh%n_node
1212  do j = 1, nn
1213  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = tnstrain(nn*(i-1)+j)
1214  enddo
1215  enddo
1216  iitem = iitem + nn
1217  endif
1218 
1219  ! --- CONTACT NORMAL FORCE @node
1220  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1221  ncomp = ncomp + 1
1222  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
1223  fstrresult%nn_dof(ncomp) = nn
1224  fstrresult%node_label(ncomp) = 'CONTACT_NFORCE'
1225  do i = 1, hecmesh%n_node
1226  do j = 1, nn
1227  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NFORCE(nn*(i-1)+j)
1228  enddo
1229  enddo
1230  iitem = iitem + nn
1231  endif
1232 
1233  ! --- CONTACT FRICTION FORCE @node
1234  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1235  ncomp = ncomp + 1
1236  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
1237  fstrresult%nn_dof(ncomp) = nn
1238  fstrresult%node_label(ncomp) = 'CONTACT_FRICTION'
1239  do i = 1, hecmesh%n_node
1240  do j = 1, nn
1241  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FRIC(nn*(i-1)+j)
1242  enddo
1243  enddo
1244  iitem = iitem + nn
1245  endif
1246 
1247  ! --- CONTACT RELATIVE VELOCITY @node
1248  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1249  ncomp = ncomp + 1
1250  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
1251  fstrresult%nn_dof(ncomp) = nn
1252  fstrresult%node_label(ncomp) = 'CONTACT_RELVEL'
1253  do i = 1, hecmesh%n_node
1254  do j = 1, nn
1255  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_RELVEL(nn*(i-1)+j)
1256  enddo
1257  enddo
1258  iitem = iitem + nn
1259  endif
1260 
1261  ! --- CONTACT STATE @node
1262  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1263  ncomp = ncomp + 1
1264  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
1265  fstrresult%nn_dof(ncomp) = nn
1266  fstrresult%node_label(ncomp) = 'CONTACT_STATE'
1267  do i = 1, hecmesh%n_node
1268  do j = 1, nn
1269  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_STATE(nn*(i-1)+j)
1270  enddo
1271  enddo
1272  iitem = iitem + nn
1273  endif
1274 
1275  ! --- CONTACT NORMAL TRACTION @node
1276  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1277  ncomp = ncomp + 1
1278  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
1279  fstrresult%nn_dof(ncomp) = nn
1280  fstrresult%node_label(ncomp) = 'CONTACT_NTRACTION'
1281  do i = 1, hecmesh%n_node
1282  do j = 1, nn
1283  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NTRAC(nn*(i-1)+j)
1284  enddo
1285  enddo
1286  iitem = iitem + nn
1287  endif
1288 
1289  ! --- CONTACT FRICTION TRACTION @node
1290  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1291  ncomp = ncomp + 1
1292  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
1293  fstrresult%nn_dof(ncomp) = nn
1294  fstrresult%node_label(ncomp) = 'CONTACT_FTRACTION'
1295  do i = 1, hecmesh%n_node
1296  do j = 1, nn
1297  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FTRAC(nn*(i-1)+j)
1298  enddo
1299  enddo
1300  iitem = iitem + nn
1301  endif
1302 
1303  ! --- NODE ID @node
1304  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
1305  ncomp = ncomp + 1
1306  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
1307  fstrresult%nn_dof(ncomp) = nn
1308  fstrresult%node_label(ncomp) = 'NODE_ID'
1309  do i = 1, hecmesh%n_node
1310  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = hecmesh%global_node_ID(i)
1311  enddo
1312  iitem = iitem + nn
1313  endif
1314 
1315  ! --- TEMPERATURE @node
1316  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
1317  ! ncomp = ncomp + 1
1318  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
1319  ! fstrRESULT%nn_dof(ncomp) = nn
1320  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
1321  ! do i = 1, hecMESH%n_node
1322  ! fstrRESULT%node_val_item(nitem*(i-1)+1+iitem) = fstrSOLID%global_node_ID(i)
1323  ! enddo
1324  ! iitem = iitem + nn
1325  !endif
1326 
1327 
1328  ! --- MATERIAL @elem
1329  if(fstrsolid%output_ctrl(4)%outinfo%on(34)) then
1330  ecomp = ecomp + 1
1331  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
1332  fstrresult%ne_dof(ecomp) = nn
1333  fstrresult%elem_label(ecomp) = 'MATERIAL_ID'
1334  ! hecMESH%section_ID holds the MPC or contact pair index for the pseudo
1335  ! elements of HEC-MW, not a section ID
1336  do i = 1, hecmesh%n_elem
1337  j = hecmesh%section_ID(i)
1338  if( j >= 1 .and. j <= hecmesh%section%n_sect ) then
1339  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section%sect_mat_ID_item(j)
1340  else
1341  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 0.d0
1342  endif
1343  enddo
1344  jitem = jitem + nn
1345  endif
1346 
1347  ! --- ELEM ID @elem
1348  if(fstrsolid%output_ctrl(4)%outinfo%on(39)) then
1349  ecomp = ecomp + 1
1350  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
1351  fstrresult%ne_dof(ecomp) = nn
1352  fstrresult%elem_label(ecomp) = 'ELEM_ID'
1353  do i = 1, hecmesh%n_elem
1354  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%global_elem_ID(i)
1355  enddo
1356  jitem = jitem + nn
1357  endif
1358 
1359  ! --- SECTION ID @elem
1360  if(fstrsolid%output_ctrl(4)%outinfo%on(40)) then
1361  ecomp = ecomp + 1
1362  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
1363  fstrresult%ne_dof(ecomp) = nn
1364  fstrresult%elem_label(ecomp) = 'SECTION_ID'
1365  do i = 1, hecmesh%n_elem
1366  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section_ID(i)
1367  enddo
1368  jitem = jitem + nn
1369  endif
1370 
1371  ! --- ELEMACT flag @element
1372  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
1373  ecomp = ecomp + 1
1374  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
1375  fstrresult%ne_dof(ecomp) = nn
1376  fstrresult%elem_label(ecomp) = 'ELEMACT'
1377  do i = 1, hecmesh%n_elem
1378  if( fstrsolid%elements(i)%elemact_flag /= kelact_inactive ) then
1379  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 1.d0
1380  else
1381  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 0.d0
1382  end if
1383  enddo
1384  jitem = jitem + nn
1385  endif
1386 
1387  if( present(label_suffix) ) then
1388  do i = 1, fstrresult%nn_component
1389  fstrresult%node_label(i) = trim(fstrresult%node_label(i))//trim(label_suffix)
1390  enddo
1391  do i = 1, fstrresult%ne_component
1392  fstrresult%elem_label(i) = trim(fstrresult%elem_label(i))//trim(label_suffix)
1393  enddo
1394  endif
1395 
1396  end subroutine fstr_make_result
1397 
1398  !C***
1402  !C***
1403  subroutine fstr_merge_result( hecMESH, fstrRESULT, fstrRESULT_add )
1404  use m_fstr
1405  use hecmw_util
1406 
1407  implicit none
1408  type (hecmwst_local_mesh) :: hecmesh
1409  type (hecmwst_result_data) :: fstrresult
1410  type (hecmwst_result_data) :: fstrresult_add
1411 
1412  type (hecmwst_result_data) :: res
1413  integer(kind=kint) :: i, j, gitem, nitem, eitem, nitem_a, eitem_a
1414 
1415  gitem = sum( fstrresult%ng_dof(1:fstrresult%ng_component) )
1416  nitem = sum( fstrresult%nn_dof(1:fstrresult%nn_component) )
1417  eitem = sum( fstrresult%ne_dof(1:fstrresult%ne_component) )
1418  nitem_a = sum( fstrresult_add%nn_dof(1:fstrresult_add%nn_component) )
1419  eitem_a = sum( fstrresult_add%ne_dof(1:fstrresult_add%ne_component) )
1420 
1421  call hecmw_nullify_result_data( res )
1422  res%ng_component = fstrresult%ng_component
1423  res%nn_component = fstrresult%nn_component + fstrresult_add%nn_component
1424  res%ne_component = fstrresult%ne_component + fstrresult_add%ne_component
1425  allocate( res%ng_dof(res%ng_component), res%global_label(res%ng_component) )
1426  allocate( res%nn_dof(res%nn_component), res%node_label(res%nn_component) )
1427  allocate( res%ne_dof(res%ne_component), res%elem_label(res%ne_component) )
1428  allocate( res%global_val_item(gitem) )
1429  allocate( res%node_val_item((nitem+nitem_a)*hecmesh%n_node) )
1430  allocate( res%elem_val_item((eitem+eitem_a)*hecmesh%n_elem) )
1431 
1432  res%ng_dof(1:res%ng_component) = fstrresult%ng_dof(1:res%ng_component)
1433  res%global_label(1:res%ng_component) = fstrresult%global_label(1:res%ng_component)
1434  res%global_val_item(1:gitem) = fstrresult%global_val_item(1:gitem)
1435 
1436  res%nn_dof(1:fstrresult%nn_component) = fstrresult%nn_dof(1:fstrresult%nn_component)
1437  res%nn_dof(fstrresult%nn_component+1:) = fstrresult_add%nn_dof(1:fstrresult_add%nn_component)
1438  res%node_label(1:fstrresult%nn_component) = fstrresult%node_label(1:fstrresult%nn_component)
1439  res%node_label(fstrresult%nn_component+1:) = fstrresult_add%node_label(1:fstrresult_add%nn_component)
1440  do i = 1, hecmesh%n_node
1441  do j = 1, nitem
1442  res%node_val_item((nitem+nitem_a)*(i-1)+j) = fstrresult%node_val_item(nitem*(i-1)+j)
1443  enddo
1444  do j = 1, nitem_a
1445  res%node_val_item((nitem+nitem_a)*(i-1)+nitem+j) = fstrresult_add%node_val_item(nitem_a*(i-1)+j)
1446  enddo
1447  enddo
1448 
1449  res%ne_dof(1:fstrresult%ne_component) = fstrresult%ne_dof(1:fstrresult%ne_component)
1450  res%ne_dof(fstrresult%ne_component+1:) = fstrresult_add%ne_dof(1:fstrresult_add%ne_component)
1451  res%elem_label(1:fstrresult%ne_component) = fstrresult%elem_label(1:fstrresult%ne_component)
1452  res%elem_label(fstrresult%ne_component+1:) = fstrresult_add%elem_label(1:fstrresult_add%ne_component)
1453  do i = 1, hecmesh%n_elem
1454  do j = 1, eitem
1455  res%elem_val_item((eitem+eitem_a)*(i-1)+j) = fstrresult%elem_val_item(eitem*(i-1)+j)
1456  enddo
1457  do j = 1, eitem_a
1458  res%elem_val_item((eitem+eitem_a)*(i-1)+eitem+j) = fstrresult_add%elem_val_item(eitem_a*(i-1)+j)
1459  enddo
1460  enddo
1461 
1462  call hecmw_result_free( fstrresult )
1463  fstrresult = res
1464  end subroutine fstr_merge_result
1465 
1466  subroutine fstr_make_result_main( hecMESH, fstrSOLID, fstrRESULT, RES, nitem, &
1467  & iitem, ncomp, eitem, jitem, ecomp, clyr )
1468  use m_fstr
1469  use m_out
1470  use m_static_lib
1471  use mmaterial
1472  use hecmw_util
1473 
1474  implicit none
1475  type (hecmwST_local_mesh) :: hecMESH
1476  type (fstr_solid) :: fstrSOLID
1477  type (hecmwST_result_data):: fstrRESULT
1478  type (fstr_solid_physic_val) :: RES
1479 
1480  character(len=16) :: clyr
1481  character(len=12) :: cnum
1482  integer(kind=kint) :: i, j, k, ndof, nitem, eitem, nn
1483  integer(kind=kint) :: iitem, ncomp, jitem, ecomp
1484  integer(kind=kint) :: isect, cdsys_ID, serr
1485  real(kind=kreal) :: coords(3,3), coordsys(3, 3)
1486  ndof = hecmesh%n_dof
1487 
1488  ! --- STRAIN @node
1489  if( fstrsolid%output_ctrl(4)%outinfo%on(3)) then
1490  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )
1491  ncomp = ncomp + 1
1492  fstrresult%nn_dof(ncomp) = nn
1493  fstrresult%node_label(ncomp) = 'NodalSTRAIN'//trim(clyr)
1494  do i = 1, hecmesh%n_node
1495  do j = 1, nn
1496  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRAIN(nn*(i-1)+j)
1497  enddo
1498  enddo
1499  iitem = iitem + nn
1500  endif
1501 
1502  ! --- STRESS @node
1503  if(fstrsolid%output_ctrl(4)%outinfo%on(4)) then
1504  ncomp = ncomp + 1
1505  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )
1506  fstrresult%nn_dof(ncomp) = nn
1507  fstrresult%node_label(ncomp) = 'NodalSTRESS'//trim(clyr)
1508  do i = 1, hecmesh%n_node
1509  do j = 1, nn
1510  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRESS((nn)*(i-1)+j)
1511  enddo
1512  enddo
1513  iitem = iitem + nn
1514  endif
1515 
1516  ! --- MISES @node
1517  if(fstrsolid%output_ctrl(4)%outinfo%on(5)) then
1518  ncomp = ncomp + 1
1519  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )
1520  fstrresult%nn_dof(ncomp) = nn
1521  fstrresult%node_label(ncomp) = 'NodalMISES'//trim(clyr)
1522  do i = 1, hecmesh%n_node
1523  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = res%MISES(i)
1524  enddo
1525  iitem = iitem + nn
1526  endif
1527 
1528  ! --- Princ STRESS @node
1529  if(fstrsolid%output_ctrl(4)%outinfo%on(19)) then
1530  ncomp = ncomp + 1
1531  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )
1532  fstrresult%nn_dof(ncomp) = nn
1533  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESS'//trim(clyr)
1534  do i = 1, hecmesh%n_node
1535  do j = 1, nn
1536  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS((nn)*(i-1)+j)
1537  enddo
1538  enddo
1539  iitem = iitem + nn
1540  endif
1541 
1542  ! --- Princ STRESS Vector @node
1543  if(fstrsolid%output_ctrl(4)%outinfo%on(23)) then
1544  do k=1,3
1545  write(cnum, '(i0)') k
1546  ncomp = ncomp + 1
1547  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )
1548  fstrresult%nn_dof(ncomp) = nn
1549  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
1550  do i = 1, hecmesh%n_node
1551  do j = 1, nn
1552  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS_VECT((nn)*(i-1)+j,k)
1553  enddo
1554  enddo
1555  iitem = iitem + nn
1556  end do
1557  endif
1558 
1559  ! --- Princ STRAIN @node
1560  if( fstrsolid%output_ctrl(4)%outinfo%on(21)) then
1561  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )
1562  ncomp = ncomp + 1
1563  fstrresult%nn_dof(ncomp) = nn
1564  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAIN'//trim(clyr)
1565  do i = 1, hecmesh%n_node
1566  do j = 1, nn
1567  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN(nn*(i-1)+j)
1568  enddo
1569  enddo
1570  iitem = iitem + nn
1571  endif
1572 
1573  ! --- Princ STRAIN Vector @node
1574  if( fstrsolid%output_ctrl(4)%outinfo%on(25)) then
1575  do k=1,3
1576  write(cnum, '(i0)') k
1577  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )
1578  ncomp = ncomp + 1
1579  fstrresult%nn_dof(ncomp) = nn
1580  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
1581  do i = 1, hecmesh%n_node
1582  do j = 1, nn
1583  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN_VECT(nn*(i-1)+j,k)
1584  enddo
1585  enddo
1586  iitem = iitem + nn
1587  enddo
1588  endif
1589 
1590  ! --- STRAIN @elem
1591  if( fstrsolid%output_ctrl(4)%outinfo%on(6)) then
1592  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
1593  ecomp = ecomp + 1
1594  fstrresult%ne_dof(ecomp) = nn
1595  fstrresult%elem_label(ecomp) = 'ElementalSTRAIN'
1596  do i = 1, hecmesh%n_elem
1597  do j = 1, nn
1598  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRAIN(nn*(i-1)+j)
1599  enddo
1600  enddo
1601  jitem = jitem + nn
1602  endif
1603 
1604  ! --- STRESS @elem
1605  if(fstrsolid%output_ctrl(4)%outinfo%on(7)) then
1606  ecomp = ecomp + 1
1607  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
1608  fstrresult%ne_dof(ecomp) = nn
1609  fstrresult%elem_label(ecomp) = 'ElementalSTRESS'
1610  do i = 1, hecmesh%n_elem
1611  do j = 1, nn
1612  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRESS((nn)*(i-1)+j)
1613  enddo
1614  enddo
1615  jitem = jitem + nn
1616  endif
1617 
1618  ! --- MISES @elem
1619  if(fstrsolid%output_ctrl(4)%outinfo%on(8)) then
1620  ecomp = ecomp + 1
1621  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
1622  fstrresult%ne_dof(ecomp) = nn
1623  fstrresult%elem_label(ecomp) = 'ElementalMISES'
1624  do i = 1, hecmesh%n_elem
1625  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EMISES(i)
1626  enddo
1627  jitem = jitem + nn
1628  endif
1629 
1630  ! --- Principal_STRESS @element
1631  if(fstrsolid%output_ctrl(4)%outinfo%on(20)) then
1632  ecomp = ecomp + 1
1633  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
1634  fstrresult%ne_dof(ecomp) = nn
1635  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESS'
1636  do i = 1, hecmesh%n_elem
1637  do j = 1, nn
1638  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS((nn)*(i-1)+j)
1639  enddo
1640  enddo
1641  jitem = jitem + nn
1642  endif
1643 
1644  ! --- Principal_STRAIN @element
1645  if(fstrsolid%output_ctrl(4)%outinfo%on(22)) then
1646  ecomp = ecomp + 1
1647  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
1648  fstrresult%ne_dof(ecomp) = nn
1649  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAIN'
1650  do i = 1, hecmesh%n_elem
1651  do j = 1, nn
1652  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN((nn)*(i-1)+j)
1653  enddo
1654  enddo
1655  jitem = jitem + nn
1656  endif
1657 
1658  ! --- ELEM PRINC STRESS VECTOR
1659  if(fstrsolid%output_ctrl(4)%outinfo%on(24)) then
1660  do k = 1, 3
1661  write(cnum,'(i0)')k
1662  ecomp = ecomp + 1
1663  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
1664  fstrresult%ne_dof(ecomp) = nn
1665  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESSVector'//trim(cnum)
1666  do i = 1, hecmesh%n_elem
1667  do j = 1, nn
1668  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS_VECT((nn)*(i-1)+j,k)
1669  enddo
1670  enddo
1671  jitem = jitem + nn
1672  enddo
1673  endif
1674 
1675  ! --- ELEM PRINC STRAIN VECTOR
1676  if(fstrsolid%output_ctrl(4)%outinfo%on(26)) then
1677  do k = 1, 3
1678  write(cnum,'(i0)')k
1679  ecomp = ecomp + 1
1680  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
1681  fstrresult%ne_dof(ecomp) = nn
1682  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAINVector'//trim(cnum)
1683  do i = 1, hecmesh%n_elem
1684  do j = 1, nn
1685  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN_VECT((nn)*(i-1)+j,k)
1686  enddo
1687  enddo
1688  jitem = jitem + nn
1689  enddo
1690  endif
1691 
1692  ! --- PLSTRAIN @elem
1693  if(fstrsolid%output_ctrl(4)%outinfo%on(43)) then
1694  ecomp = ecomp + 1
1695  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
1696  fstrresult%ne_dof(ecomp) = nn
1697  fstrresult%elem_label(ecomp) = 'ElementalPLSTRAIN'
1698  do i = 1, hecmesh%n_elem
1699  if( len_trim(clyr) == 0 ) then
1700  if( associated(fstrsolid%elements(i)%shell_layer_gausses) ) then
1701  res%EPLSTRAIN(i) = fstrsolid%EPLSTRAIN(i)
1702  else
1703  res%EPLSTRAIN(i) = fstr_element_average_plstrain(fstrsolid%elements(i))
1704  endif
1705  endif
1706  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EPLSTRAIN(i)
1707  enddo
1708  jitem = jitem + nn
1709  endif
1710 
1711  ! --- ORIENTATION @elem
1712  if(fstrsolid%output_ctrl(4)%outinfo%on(42)) then
1713  do i = 1, 3
1714  write(cnum,'(i0)')i
1715  ecomp = ecomp + 1
1716  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(42), ndof )
1717  fstrresult%ne_dof(ecomp) = nn
1718  fstrresult%elem_label(ecomp) = 'ORIENTATION'//trim(cnum)
1719  enddo
1720  ! hecMESH%section_ID holds the MPC or contact pair index for the pseudo
1721  ! elements of HEC-MW, not a section ID
1722  do i = 1, hecmesh%n_elem
1723  isect = hecmesh%section_ID(i)
1724  if( isect >= 1 .and. isect <= hecmesh%section%n_sect ) then
1725  cdsys_id = hecmesh%section%sect_orien_ID(isect)
1726  else
1727  cdsys_id = -1
1728  endif
1729  if(cdsys_id == -1) then
1730  coordsys(:,:) = 0.0d0
1731  else
1732  call get_coordsys(cdsys_id, hecmesh, fstrsolid, coords, i)
1733  call set_localcoordsys( coords, g_localcoordsys(cdsys_id), coordsys(:, :), serr )
1734  endif
1735  do j = 1, 3
1736  do k = 1, 3
1737  fstrresult%elem_val_item(eitem*(i-1)+jitem+nn*(j-1)+k) = coordsys(j,k)
1738  enddo
1739  enddo
1740  enddo
1741  jitem = jitem + 3*nn
1742  endif
1743 
1744  end subroutine fstr_make_result_main
1745 
1746  subroutine fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
1747  use m_fstr
1748  use m_out
1749  use m_static_lib
1750 
1751  implicit none
1752  type (fstr_solid) :: fstrsolid
1753  type (hecmwst_local_mesh) :: hecmesh
1754  integer(kind=kint) :: j, itype, is, ie, ic_type, js, icel
1755  integer(kind=kint) :: n1, n2
1756  real(kind=kreal), allocatable :: unode(:)
1757 
1758  do itype = 1, hecmesh%n_elem_type
1759  is = hecmesh%elem_type_index(itype-1) + 1
1760  ie = hecmesh%elem_type_index(itype )
1761  ic_type = hecmesh%elem_type_item(itype)
1762  if(ic_type == 781)then
1763  do icel = is, ie
1764  js = hecmesh%elem_node_index(icel-1)
1765  do j = 1, 4
1766  n1 = hecmesh%elem_node_item(js+j )
1767  n2 = hecmesh%elem_node_item(js+j+4)
1768  unode(3*n2-2) = unode(3*n1-2)
1769  unode(3*n2-1) = unode(3*n1-1)
1770  unode(3*n2 ) = unode(3*n1 )
1771  enddo
1772  enddo
1773  elseif(ic_type == 761)then
1774  do icel = is, ie
1775  js = hecmesh%elem_node_index(icel-1)
1776  do j = 1, 3
1777  n1 = hecmesh%elem_node_item(js+j )
1778  n2 = hecmesh%elem_node_item(js+j+3)
1779  unode(3*n2-2) = unode(3*n1-2)
1780  unode(3*n2-1) = unode(3*n1-1)
1781  unode(3*n2 ) = unode(3*n1 )
1782  enddo
1783  enddo
1784  endif
1785  enddo
1786 
1787  end subroutine fstr_reorder_node_shell
1788 
1789  subroutine fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
1790  use m_fstr
1791  use m_out
1792  use m_static_lib
1793 
1794  implicit none
1795  type (fstr_solid) :: fstrsolid
1796  type (hecmwst_local_mesh) :: hecmesh
1797  integer(kind=kint) :: j, itype, is, ie, ic_type, js, icel
1798  integer(kind=kint) :: n1, n2
1799  real(kind=kreal), allocatable :: unode(:)
1800 
1801  do itype = 1, hecmesh%n_elem_type
1802  is = hecmesh%elem_type_index(itype-1) + 1
1803  ie = hecmesh%elem_type_index(itype )
1804  ic_type = hecmesh%elem_type_item(itype)
1805  if(ic_type == 781)then
1806  do icel = is, ie
1807  js = hecmesh%elem_node_index(icel-1)
1808  do j = 1, 4
1809  n1 = hecmesh%elem_node_item(js+j)
1810  n2 = hecmesh%elem_node_item(js+j+4)
1811  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1812  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1813  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1814  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1815  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1816  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1817  enddo
1818  enddo
1819  elseif(ic_type == 761)then
1820  do icel = is, ie
1821  js = hecmesh%elem_node_index(icel-1)
1822  do j = 1, 3
1823  n1 = hecmesh%elem_node_item(js+j)
1824  n2 = hecmesh%elem_node_item(js+j+3)
1825 
1826  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1827  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1828  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1829  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1830  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1831  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1832  enddo
1833  enddo
1834  endif
1835  enddo
1836 
1837  end subroutine fstr_reorder_rot_shell
1838 
1841  subroutine fstr_reorder_rot_beam(fstrSOLID, hecMESH, unode)
1842  use m_fstr
1843 
1844  implicit none
1845  type (fstr_solid) :: fstrsolid
1846  type (hecmwst_local_mesh) :: hecmesh
1847  real(kind=kreal) :: unode(:)
1848  integer(kind=kint) :: j, itype, is, ie, ic_type, js, icel
1849  integer(kind=kint) :: n1, n2
1850 
1851  do itype = 1, hecmesh%n_elem_type
1852  is = hecmesh%elem_type_index(itype-1) + 1
1853  ie = hecmesh%elem_type_index(itype )
1854  ic_type = hecmesh%elem_type_item(itype)
1855  if(ic_type /= 641) cycle
1856  do icel = is, ie
1857  js = hecmesh%elem_node_index(icel-1)
1858  do j = 1, 2
1859  n1 = hecmesh%elem_node_item(js+j)
1860  n2 = hecmesh%elem_node_item(js+j+2)
1861  unode(3*n1-2:3*n1) = fstrsolid%unode(3*n2-2:3*n2)
1862  unode(3*n2-2:3*n2) = fstrsolid%unode(3*n2-2:3*n2)
1863  enddo
1864  enddo
1865  enddo
1866 
1867  end subroutine fstr_reorder_rot_beam
1868 
1869  subroutine fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
1870  use m_fstr
1871  use m_out
1872  use m_static_lib
1873 
1874  implicit none
1875  type (fstr_solid) :: fstrsolid
1876  type (hecmwst_local_mesh) :: hecmesh
1877  integer(kind=kint) :: j, itype, is, ie, ic_type, js, icel
1878  integer(kind=kint) :: a, b
1879  real(kind=kreal), allocatable :: unode(:)
1880 
1881  do itype = 1, hecmesh%n_elem_type
1882  is = hecmesh%elem_type_index(itype-1) + 1
1883  ie = hecmesh%elem_type_index(itype )
1884  ic_type = hecmesh%elem_type_item(itype)
1885  if(ic_type == 641)then
1886  do icel = is, ie
1887  js = hecmesh%elem_node_index(icel-1)
1888  do j = 1, 2
1889  a = hecmesh%elem_node_item(js+j)
1890  b = hecmesh%elem_node_item(js+j+2)
1891  unode(3*b-2) = unode(3*a-2)
1892  unode(3*b-1) = unode(3*a-1)
1893  unode(3*b ) = unode(3*a )
1894  enddo
1895  enddo
1896  endif
1897  enddo
1898 
1899  end subroutine fstr_reorder_node_beam
1900 
1901  subroutine setup_contact_output_variables( hecMESH, fstrSOLID, phase, dtime, expflag )
1902  use m_fstr
1903  use hecmw_util
1904  use mcontact
1905  implicit none
1906  type(hecmwst_local_mesh), intent(in) :: hecmesh
1907  type (fstr_solid), intent(inout) :: fstrsolid
1908  integer(kind=kint), intent(in) :: phase
1909  real(kind=kreal), optional, intent(in) :: dtime
1910  logical, optional, intent(in) :: expflag
1911 
1912  integer(kind=kint), parameter :: nval = 10
1913  ! Force threshold (|F|^2) below which an output contact force counts as zero.
1914  real(kind=kreal), parameter :: cont_force_eps2 = 1.d-40
1915  logical, save :: updated(nval) = .false.
1916  integer(kind=kint) :: ndof, i, ic, is, jn, slave
1917  real(kind=kreal) :: area, dt_use
1918 
1919  ndof = hecmesh%n_dof
1920 
1921  if( phase == -1 ) then
1922  updated(1:nval) = .false.
1923  return
1924  else
1925  if( phase /= 3 .and. phase /= 4 ) return !irregular case
1926  end if
1927 
1928  ! Update contact state vectors if dtime is provided
1929  ! present() is tested on its own: .and. does not short-circuit, so an absent dtime would be referenced
1930  dt_use = 1.d0 ! default value if dtime not available
1931  if( present(dtime) ) then
1932  if( dtime > 0.d0 ) dt_use = dtime
1933  endif
1934  if( .not. updated(3) .and. .not. updated(4) ) then
1935  call fstr_update_contact_state_vectors( fstrsolid, dt_use )
1936  endif
1937 
1938  ! MORTAR=YES: make the displayed contact state consistent with the displayed force.
1939  ! The state vector above aggregates each segment's state onto its slave nodes, so a node
1940  ! whose multiplier has already relaxed can still be shown as in contact, and the segment
1941  ! state cannot distinguish stick from slip. For every mortar slave node that carries a
1942  ! nonzero output force, take the state from that node's converged friction state
1943  ! (slip if any master rank slipped, else stick); nodes with round-off-zero force keep the
1944  ! scanned state (FREE right after separation). Limited to mortar slave nodes: CONT_NFORCE
1945  ! is also written on master nodes and by the NODE-SURF path. Runs before the parallel
1946  ! contact-value assembly so that rank-local force and state are compared in the same index
1947  ! space; the existing max-assembly of CONT_STATE then heals boundary nodes.
1948  if( associated(fstrsolid%CONT_STATE) .and. associated(fstrsolid%CONT_NFORCE) ) then
1949  do ic = 1, fstrsolid%n_contacts
1950  if( fstrsolid%contacts(ic)%method /= contacts2s ) cycle
1951  if( .not. associated(fstrsolid%contacts(ic)%slave_surf) ) cycle
1952  do is = 1, size(fstrsolid%contacts(ic)%slave_surf)
1953  do jn = 1, size(fstrsolid%contacts(ic)%slave_surf(is)%nodes)
1954  slave = fstrsolid%contacts(ic)%slave_surf(is)%nodes(jn)
1955  if( dot_product( fstrsolid%CONT_NFORCE(3*slave-2:3*slave), &
1956  & fstrsolid%CONT_NFORCE(3*slave-2:3*slave) ) > cont_force_eps2 ) then
1957  if( any( fstrsolid%contacts(ic)%slave_surf(is)%lam_work_fstate(jn, &
1958  & 1:fstrsolid%contacts(ic)%slave_surf(is)%lam_work_n) == contactslip ) ) then
1959  fstrsolid%CONT_STATE(slave) = dble(contactslip)
1960  else
1961  fstrsolid%CONT_STATE(slave) = dble(contactstick)
1962  endif
1963  endif
1964  enddo
1965  enddo
1966  enddo
1967  endif
1968 
1969  ! --- CONTACT NORMAL FORCE @node
1970  if( fstrsolid%output_ctrl(phase)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1971  if( .not. updated(1) ) then
1972  ! Explicit dynamic has no Lagrange matrix, so the solver cannot fill CONT_NFORCE
1973  ! via fstr_calc_contact_output_force. Build it here from the stored contact
1974  ! multipliers before the parallel aggregation. Implicit/static keep the value
1975  ! already computed inside the solver (flag absent), so this is a no-op for them.
1976  ! present() is tested on its own, as for dtime above
1977  if( present(expflag) ) then
1978  if( expflag ) call fstr_calc_contact_output_force_exp( hecmesh, fstrsolid )
1979  end if
1980  if( paracontactflag ) then
1981  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1982  end if
1983  end if
1984  updated(1) = .true.
1985  endif
1986 
1987  ! --- CONTACT FRICTION FORCE @node
1988  if( fstrsolid%output_ctrl(phase)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1989  if( paracontactflag .and. .not. updated(2)) then
1990  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1991  end if
1992  updated(2) = .true.
1993  endif
1994 
1995  ! --- CONTACT RELATIVE VELOCITY @node
1996  if( fstrsolid%output_ctrl(phase)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1997  if( paracontactflag .and. .not. updated(3)) then
1998  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_RELVEL,1)
1999  end if
2000  updated(3) = .true.
2001  endif
2002 
2003  ! --- CONTACT STATE @node
2004  if( fstrsolid%output_ctrl(phase)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
2005  if( paracontactflag .and. .not. updated(4)) then
2006  call fstr_setup_parancon_contactvalue(hecmesh,1,fstrsolid%CONT_STATE,2)
2007  end if
2008  updated(4) = .true.
2009  endif
2010 
2011  ! --- CONTACT AREA for CONTACT TRACTION
2012  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .or. fstrsolid%output_ctrl(phase)%outinfo%on(37) ) then
2013  if( .not. updated(5)) call calc_contact_area( hecmesh, fstrsolid, 0 )
2014  ! fstr_setup_parancon_contactvalue is not necessary because
2015  ! contact area is calculated from original surface group
2016  end if
2017 
2018  ! --- CONTACT NORMAL TRACTION @node
2019  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
2020  if( paracontactflag .and. .not. updated(6)) then
2021  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
2022  end if
2023  fstrsolid%CONT_NTRAC(:) = 0.d0
2024  do i=1,hecmesh%nn_internal
2025  area = fstrsolid%CONT_AREA(i)
2026  if( area < 1.d-16 ) cycle
2027  fstrsolid%CONT_NTRAC(3*i-2:3*i) = fstrsolid%CONT_NFORCE(3*i-2:3*i)/area
2028  end do
2029  if( paracontactflag ) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NTRAC,1)
2030  updated(6) = .true.
2031  endif
2032 
2033  ! --- CONTACT FRICTION TRACTION @node
2034  if( fstrsolid%output_ctrl(phase)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
2035  if( paracontactflag .and. .not. updated(7)) then
2036  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
2037  end if
2038  fstrsolid%CONT_FTRAC(:) = 0.d0
2039  do i=1,hecmesh%nn_internal
2040  area = fstrsolid%CONT_AREA(i)
2041  if( area < 1.d-16 ) cycle
2042  fstrsolid%CONT_FTRAC(3*i-2:3*i) = fstrsolid%CONT_FRIC(3*i-2:3*i)/area
2043  end do
2044  if( paracontactflag ) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FTRAC,1)
2045  updated(7) = .true.
2046  endif
2047 
2048  end subroutine
2049 
2050 end module m_make_result
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_util::hecmw_max
integer(kind=kint), parameter hecmw_max
Definition: hecmw_util_f.F90:34
hecmw_util::kreal
integer(kind=4), parameter kreal
Definition: hecmw_util_f.F90:16
m_fstr_nodalstress
This module provides functions to calculation nodal stress.
Definition: fstr_NodalStress.f90:6
m_fstr_nodalstress::fstr_get_shell_gauss_output
subroutine fstr_get_shell_gauss_output(hecMESH, fstrSOLID, icel, k, strain, stress)
Read stored shell tensors or evaluate one elastic thickness point without changing history.
Definition: fstr_NodalStress.f90:16
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.F90:15
m_fstr::get_coordsys
subroutine get_coordsys(cdsys_ID, hecMESH, fstrSOLID, coords, icel)
This subroutine fetch coords defined by local coordinate system.
Definition: m_fstr.F90:1307
m_fstr::paracontactflag
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.F90:111
m_make_result
This module provide a function to prepare output of static analysis.
Definition: make_result.f90:6
m_make_result::fstr_merge_result
subroutine, public fstr_merge_result(hecMESH, fstrRESULT, fstrRESULT_add)
MERGE the node and the element components of two result data into one, so that plural sets of the sam...
Definition: make_result.f90:1404
m_make_result::fstr_write_result_main
subroutine fstr_write_result_main(hecMESH, fstrSOLID, RES, clyr, label_suffix)
Definition: make_result.f90:554
m_make_result::fstr_reorder_node_shell
subroutine, public fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1747
m_make_result::fstr_write_result
subroutine, public fstr_write_result(hecMESH, fstrSOLID, istep, time, flag, fstrDYNAMIC)
OUTPUT result file for static and dynamic analysis.
Definition: make_result.f90:25
m_make_result::result_add
subroutine result_add(dtype, n_dof, label, label_suffix, data)
Definition: make_result.f90:538
m_make_result::fstr_reorder_node_beam
subroutine, public fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1870
m_make_result::fstr_write_shell_gauss_result
subroutine fstr_write_shell_gauss_result(hecMESH, fstrSOLID, label_suffix)
Write one thickness-point field at a time, sharing evaluation of strain and stress.
Definition: make_result.f90:499
m_make_result::fstr_write_result_add
subroutine, public fstr_write_result_add(hecMESH, fstrSOLID, istep, label_suffix, fstrDYNAMIC)
ADD result items of static and dynamic analysis to the result file being written. label_suffix is app...
Definition: make_result.f90:80
m_make_result::fstr_reorder_rot_beam
subroutine, public fstr_reorder_rot_beam(fstrSOLID, hecMESH, unode)
Rotation of 641 beams: nodes 3 and 4 carry the rotations of nodes 1 and 2 as their displacements....
Definition: make_result.f90:1842
m_make_result::setup_contact_output_variables
subroutine, public setup_contact_output_variables(hecMESH, fstrSOLID, phase, dtime, expflag)
Definition: make_result.f90:1902
m_make_result::fstr_make_result_main
subroutine fstr_make_result_main(hecMESH, fstrSOLID, fstrRESULT, RES, nitem, iitem, ncomp, eitem, jitem, ecomp, clyr)
Definition: make_result.f90:1468
m_make_result::fstr_reorder_rot_shell
subroutine, public fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1790
m_make_result::fstr_make_result
subroutine, public fstr_make_result(hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC, label_suffix)
MAKE RESULT for static and dynamic analysis (WITHOUT ELEMENTAL RESULTS) -----------------------------...
Definition: make_result.f90:723
m_out
This module manages step information.
Definition: m_out.f90:6
m_out::n_comp_valtype
integer function n_comp_valtype(vtype, ndim)
Definition: m_out.f90:205
m_static_lib
This modules just summarizes all modules used in static analysis.
Definition: static_LIB.f90:6
mcontact
Top-level contact analysis module (System level)
Definition: fstr_contact.f90:33
mcontact::fstr_update_contact_state_vectors
subroutine, public fstr_update_contact_state_vectors(fstrSOLID, dt)
Update contact state output vectors for all contacts.
Definition: fstr_contact.f90:599
mcontact::fstr_calc_contact_output_force_exp
subroutine, public fstr_calc_contact_output_force_exp(hecMESH, fstrSOLID)
Explicit-dynamic counterpart of fstr_calc_contact_output_force.
Definition: fstr_contact.f90:137
mmaterial
This module summarizes all information of material properties.
Definition: material.f90:6
mmechgauss
This modules defines a structure to record history dependent parameter in static analysis.
Definition: mechgauss.f90:6
mmechgauss::fstr_shell_output_point_count
integer(kind=kint) function fstr_shell_output_point_count(element)
Number of shell thickness-point tensors available for result output.
Definition: mechgauss.f90:52
mmechgauss::fstr_element_average_plstrain
real(kind=kreal) function fstr_element_average_plstrain(element)
Average equivalent plastic strain over the active quadrature history. Average shell history points eq...
Definition: mechgauss.f90:194
hecmw_util::hecmwst_local_mesh
Definition: hecmw_util_f.F90:246
m_fstr::fstr_dynamic
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.F90:525
m_fstr::fstr_solid
Definition: m_fstr.F90:230