FrontISTR  5.7.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_make_result
11  public:: fstr_reorder_node_shell
12  public:: fstr_reorder_rot_shell
13  public:: fstr_reorder_node_beam
14  public:: setup_contact_output_variables
15 
16 contains
17 
18  !C***
20  !C***
21  subroutine fstr_write_result( hecMESH, fstrSOLID, fstrPARAM, istep, time, flag, fstrDYNAMIC)
22  use m_fstr
23  use m_out
24  use m_static_lib
25  use mmaterial
26  use hecmw_util
27 
28  implicit none
29  type (hecmwst_local_mesh) :: hecmesh
30  type (fstr_solid) :: fstrsolid
31  type (fstr_param ) :: fstrparam
32  integer(kind=kint) :: istep, flag
33  type (fstr_dynamic), intent(in), optional :: fstrdynamic
34  real(kind=kreal) :: time
35  integer(kind=kint) :: n_lyr, ntot_lyr, tmp, is_33shell, is_33beam, cid
36  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, nn, mm, ngauss, it
37  real(kind=kreal), pointer :: tnstrain(:), testrain(:), yield_ratio(:)
38  integer(kind=kint) :: idx
39  real(kind=kreal), allocatable :: work(:), unode(:), rnode(:)
40  character(len=HECMW_HEADER_LEN) :: header
41  character(len=HECMW_MSG_LEN) :: comment
42  character(len=HECMW_NAME_LEN) :: s, label, nameid, addfname, cnum
43  character(len=6), allocatable :: clyr(:)
44  logical :: is_dynamic
45 
46  tnstrain => fstrsolid%TNSTRAIN
47  testrain => fstrsolid%TESTRAIN
48  yield_ratio => fstrsolid%YIELD_RATIO
49 
50  is_dynamic = present(fstrdynamic)
51 
52  if( is_dynamic ) then
53  idx = 1
54  if( fstrdynamic%idx_eqa==1 .and. istep>0 ) idx = 2
55  endif
56 
57  ndof = hecmesh%n_dof
58  mm = hecmesh%n_node
59  if( hecmesh%n_elem > hecmesh%n_node ) mm = hecmesh%n_elem
60  if( ndof==2 ) mdof = 3
61  if( ndof==3 ) mdof = 6
62  if( ndof==4 ) mdof = 6
63  if( ndof==6 ) mdof = 6
64 
65  ntot_lyr = fstrsolid%max_lyr
66  is_33shell = fstrsolid%is_33shell
67  is_33beam = fstrsolid%is_33beam
68 
69  nn = mm * mdof
70  allocate( work(nn) )
71 
72  ! --- INITIALIZE
73  header = '*fstrresult'
74  if( present(fstrdynamic) ) then
75  comment = 'dynamic_result'
76  else
77  comment = 'static_result'
78  endif
79  call hecmw_result_init( hecmesh, istep, header, comment )
80 
81  ! --- TIME
82  id = hecmw_result_dtype_global
83  label = 'TOTALTIME'
84  work(1) = time
85  call hecmw_result_add( id, 1, label, work )
86 
87  ! --- DISPLACEMENT
88  if( fstrsolid%output_ctrl(3)%outinfo%on(1) ) then
89  if(ndof == 4) then
90  id = hecmw_result_dtype_node
91  ! for VELOCITY
92  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
93  allocate( unode(3*hecmesh%n_node) )
94  unode = 0.0d0
95  do i=1, hecmesh%n_node
96  do j = 1, 3
97  unode((i-1)*3 + j) = fstrdynamic%DISP((i-1)*4 + j, idx)
98  enddo
99  enddo
100  label = 'VELOCITY'
101  call hecmw_result_add( id, nitem, label, unode )
102  deallocate( unode )
103  ! for PRESSURE
104  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 1 )
105  allocate( unode(hecmesh%n_node) )
106  unode = 0.0d0
107  do i=1, hecmesh%n_node
108  unode(i) = fstrdynamic%DISP(i*4, idx)
109  enddo
110  label = 'PRESSURE'
111  call hecmw_result_add( id, nitem, label, unode )
112  deallocate( unode )
113  else if(ndof == 6) then
114  id = hecmw_result_dtype_node
115  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
116  allocate( unode(hecmesh%n_node*3) )
117  unode = 0.0d0
118  if( is_dynamic ) then
119  do i=1, hecmesh%n_node
120  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
121  enddo
122  else
123  do i=1, hecmesh%n_node
124  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
125  enddo
126  endif
127  label = 'DISPLACEMENT'
128  call hecmw_result_add( id, nitem, label, unode )
129  deallocate( unode )
130  else
131  id = hecmw_result_dtype_node
132  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), ndof )
133  allocate( unode(hecmesh%n_node*ndof) )
134  unode = 0.0d0
135  if( is_dynamic ) then
136  unode(:) = fstrdynamic%DISP(:,idx)
137  else
138  unode(:) = fstrsolid%unode
139  endif
140  label = 'DISPLACEMENT'
141  if(is_33beam == 1)then
142  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
143  endif
144  if(is_33shell == 1)then
145  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
146  endif
147  call hecmw_result_add( id, nitem, label, unode )
148  deallocate( unode )
149  endif
150  endif
151 
152  ! --- ROTATION
153  if (fstrsolid%output_ctrl(3)%outinfo%on(18)) then
154  if(ndof == 6) then
155  id = hecmw_result_dtype_node
156  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), 3 )
157  label = 'ROTATION'
158  allocate( rnode(hecmesh%n_node*3) )
159  rnode = 0.0d0
160  if( is_dynamic ) then
161  do i=1, hecmesh%n_node
162  rnode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
163  enddo
164  else
165  do i=1, hecmesh%n_node
166  rnode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
167  enddo
168  endif
169  call hecmw_result_add( id, nitem, label, rnode )
170  deallocate( rnode )
171  else
172  if ( is_33shell == 1) then
173  id = hecmw_result_dtype_node
174  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(1), ndof )
175  label = 'ROTATION'
176  allocate( rnode(hecmesh%n_node*ndof) )
177  rnode = 0.0d0
178  call fstr_reorder_rot_shell(fstrsolid, hecmesh, rnode)
179  call hecmw_result_add( id, nitem, label, rnode )
180  deallocate( rnode )
181  end if
182  end if
183  endif
184 
185  ! --- VELOCITY
186  if( is_dynamic .and. fstrsolid%output_ctrl(3)%outinfo%on(15) ) then
187  id = hecmw_result_dtype_node
188  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(15), ndof )
189  label = 'VELOCITY'
190  call hecmw_result_add( id, nitem, label, fstrdynamic%VEL(:,idx) )
191  endif
192 
193  ! --- ACCELERATION
194  if( is_dynamic .and. fstrsolid%output_ctrl(3)%outinfo%on(16) ) then
195  id = hecmw_result_dtype_node
196  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(16), ndof )
197  label = 'ACCELERATION'
198  call hecmw_result_add( id, nitem, label, fstrdynamic%ACC(:,idx) )
199  endif
200 
201  ! --- REACTION FORCE
202  if( fstrsolid%output_ctrl(3)%outinfo%on(2) ) then
203  id = hecmw_result_dtype_node
204  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(2), ndof )
205  label = 'REACTION_FORCE'
206  call hecmw_result_add( id, nitem, label, fstrsolid%REACTION )
207  endif
208 
209  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
210 
211  if(is_33shell == 1 .or. ndof == 6)then
212  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL, " " )
213  else
214  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SOLID, " " )
215  endif
216 
217  !laminated shell
218  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(3)%outinfo%on(27) ) then
219  allocate(clyr(2*ntot_lyr))
220  do i=1,ntot_lyr
221  write(cnum,"(i0)")i
222  clyr(2*i-1)="_L"//trim(cnum)//"+"
223  clyr(2*i )="_L"//trim(cnum)//"-"
224  enddo
225  do i=1,ntot_lyr
226  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL%LAYER(i)%PLUS, clyr(2*i-1) )
227  call fstr_write_result_main( hecmesh, fstrsolid, fstrsolid%SHELL%LAYER(i)%MINUS, clyr(2*i ) )
228  enddo
229  deallocate(clyr)
230  endif
231 
232  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
233  ! --- STRAIN @gauss
234  if( fstrsolid%output_ctrl(3)%outinfo%on(9) .and. ndof/=6 ) then
235  id = hecmw_result_dtype_elem
236  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(9), ndof )
237  ngauss = fstrsolid%maxn_gauss
238  work(:) = 0.d0
239  do k = 1, ngauss
240  write(s,*) k
241  write(label,'(a,a)') 'GaussSTRAIN',trim(adjustl(s))
242  label = adjustl(label)
243  do i = 1, hecmesh%n_elem
244  if( associated(fstrsolid%elements(i)%gausses) ) then
245  if( k <= size(fstrsolid%elements(i)%gausses) ) then
246  do j = 1, nitem
247  work(nitem*(i-1)+j) = fstrsolid%elements(i)%gausses(k)%strain_out(j)
248  enddo
249  endif
250  end if
251  enddo
252  call hecmw_result_add( id, nitem, label, work )
253  enddo
254  endif
255 
256  ! --- STRESS @gauss
257  if( fstrsolid%output_ctrl(3)%outinfo%on(10) .and. ndof/=6 ) then
258  id = hecmw_result_dtype_elem
259  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(10), ndof )
260  ngauss = fstrsolid%maxn_gauss
261  work(:) = 0.d0
262  do k = 1, ngauss
263  write(s,*) k
264  write(label,'(a,a)') 'GaussSTRESS',trim(adjustl(s))
265  label = adjustl(label)
266  do i = 1, hecmesh%n_elem
267  if( associated(fstrsolid%elements(i)%gausses) ) then
268  if( k <= size(fstrsolid%elements(i)%gausses) ) then
269  do j = 1, nitem
270  work(nitem*(i-1)+j) = fstrsolid%elements(i)%gausses(k)%stress_out(j)
271  enddo
272  endif
273  end if
274  enddo
275  call hecmw_result_add( id, nitem, label, work )
276  enddo
277  endif
278 
279  ! --- PLASTIC STRAIN @gauss
280  if( fstrsolid%output_ctrl(3)%outinfo%on(11) .and. fstrsolid%StaticType/=3 ) then
281  id = hecmw_result_dtype_elem
282  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(11), ndof )
283  ngauss = fstrsolid%maxn_gauss
284  work(:) = 0.d0
285  do k = 1, ngauss
286  write(s,*) k
287  write(label,'(a,a)') 'PLASTIC_GaussSTRAIN',trim(adjustl(s))
288  label = adjustl(label)
289  do i = 1, hecmesh%n_elem
290  if( associated(fstrsolid%elements(i)%gausses) ) then
291  if( k <= size(fstrsolid%elements(i)%gausses) ) then
292  work(i) = fstrsolid%elements(i)%gausses(k)%plstrain
293  endif
294  endif
295  enddo
296  call hecmw_result_add( id, nitem, label, work )
297  enddo
298  endif
299 
300  ! --- THERMAL STRAIN @node
301  if( fstrsolid%output_ctrl(3)%outinfo%on(12) .and. associated(tnstrain) ) then
302  id = hecmw_result_dtype_node
303  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(12), ndof )
304  label = 'THERMAL_NodalSTRAIN'
305  call hecmw_result_add( id, nitem, label, tnstrain )
306  endif
307 
308  ! --- THERMAL STRAIN @element
309  if( fstrsolid%output_ctrl(3)%outinfo%on(13) .and. associated(testrain) ) then
310  id = hecmw_result_dtype_elem
311  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(13), ndof )
312  label = 'THERMAL_ElementalSTRAIN'
313  call hecmw_result_add( id, nitem, label, testrain )
314  endif
315 
316  ! --- THERMAL STRAIN @gauss
317  if( fstrsolid%output_ctrl(3)%outinfo%on(14) .and. associated(testrain) ) then
318  id = hecmw_result_dtype_elem
319  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(14), ndof )
320  ngauss = fstrsolid%maxn_gauss
321  do k = 1, ngauss
322  write(s,*) k
323  write(label,'(a,a)') 'THERMAL_GaussSTRAIN',trim(adjustl(s))
324  label = adjustl(label)
325  do i = 1, hecmesh%n_elem
326  if( k > ngauss ) then
327  do j = 1, nitem
328  work(nitem*(i-1)+j) = 0.d0
329  enddo
330  else
331  do j = 1, nitem
332  ! work(nitem*(i-1)+j) = fstrSOLID%elements(i)%gausses(k)%tstrain(j)
333  enddo
334  end if
335  enddo
336  call hecmw_result_add( id, nitem, label, work )
337  enddo
338  endif
339 
340  ! --- YIELD RATIO
341  if( fstrsolid%output_ctrl(3)%outinfo%on(29) ) then
342  id = hecmw_result_dtype_elem
343  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(29), ndof )
344  label = "YIELD_RATIO"
345  call hecmw_result_add( id, nitem, label, yield_ratio )
346  endif
347 
348  ! --- CONTACT NORMAL FORCE @node
349  if( fstrsolid%output_ctrl(3)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
350  id = hecmw_result_dtype_node
351  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(30), ndof )
352  label = 'CONTACT_NFORCE'
353  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_NFORCE )
354  endif
355 
356  ! --- CONTACT FRICTION FORCE @node
357  if( fstrsolid%output_ctrl(3)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
358  id = hecmw_result_dtype_node
359  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(31), ndof )
360  label = 'CONTACT_FRICTION'
361  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_FRIC )
362  endif
363 
364  ! --- CONTACT RELATIVE VELOCITY @node
365  if( fstrsolid%output_ctrl(3)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
366  id = hecmw_result_dtype_node
367  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(32), ndof )
368  label = 'CONTACT_RELVEL'
369  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_RELVEL )
370  endif
371 
372  ! --- CONTACT STATE @node
373  if( fstrsolid%output_ctrl(3)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
374  id = hecmw_result_dtype_node
375  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(33), ndof )
376  label = 'CONTACT_STATE'
377  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_STATE )
378  endif
379 
380  ! --- CONTACT NORMAL TRACTION @node
381  if( fstrsolid%output_ctrl(3)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
382  id = hecmw_result_dtype_node
383  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(36), ndof )
384  label = 'CONTACT_NTRACTION'
385  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_NTRAC )
386  endif
387 
388  ! --- CONTACT FRICTION TRACTION @node
389  if( fstrsolid%output_ctrl(3)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
390  id = hecmw_result_dtype_node
391  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(37), ndof )
392  label = 'CONTACT_FTRACTION'
393  call hecmw_result_add( id, nitem, label, fstrsolid%CONT_FTRAC )
394  endif
395 
396  ! --- TEMPERATURE @node
397  !if(present(fstrPARAM))then
398  ! if( fstrSOLID%output_ctrl(4)%outinfo%on(38) .and. fstrPARAM%solution_type == kstHEATSTATIC)then
399  ! ncomp = ncomp + 1
400  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(38), ndof )
401  ! fstrRESULT%nn_dof(ncomp) = nn
402  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
403  ! do i = 1, hecMESH%n_node
404  ! do j = 1, nn
405  ! fstrRESULT%node_val_item(nitem*(i-1)+j+iitem) = fstrSOLID%temperature(nn*(i-1)+j)
406  ! enddo
407  ! enddo
408  ! iitem = iitem + nn
409  ! endif
410  !endif
411 
412  ! --- WRITE
413  nameid = 'fstrRES'
414  if( flag==0 ) then
415  call hecmw_result_write_by_name( nameid )
416  else
417  addfname = '_dif'
418  call hecmw_result_write_by_addfname( nameid, addfname )
419  endif
420 
421  ! --- FINALIZE
422  call hecmw_result_finalize
423 
424  deallocate( work )
425  end subroutine fstr_write_result
426 
427  subroutine fstr_write_result_main( hecMESH, fstrSOLID, RES, clyr )
428  use m_fstr
429  use m_out
430  use m_static_lib
431  use mmaterial
432  use hecmw_util
433 
434  implicit none
435  type (hecmwST_local_mesh) :: hecMESH
436  type (fstr_solid) :: fstrSOLID
437  type (fstr_solid_physic_val) :: RES
438  integer(kind=kint) :: istep, flag
439  integer(kind=kint) :: n_lyr, cid
440 
441  character(len=HECMW_HEADER_LEN) :: header
442  character(len=HECMW_NAME_LEN) :: s, label, nameID, addfname
443  character(len=6) :: clyr
444  character(len=4) :: cnum
445  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, nn, mm, ngauss, it
446  real(kind=kreal), allocatable :: work(:)
447 
448  ndof = hecmesh%n_dof
449  allocate( work(hecmesh%n_elem) )
450 
451  ! --- STRAIN @node
452  if (fstrsolid%output_ctrl(3)%outinfo%on(3)) then
453  id = hecmw_result_dtype_node
454  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(3), ndof )
455  label = 'NodalSTRAIN'//trim(clyr)
456  call hecmw_result_add( id, nitem, label, res%STRAIN )
457  endif
458 
459  ! --- STRESS @node
460  if( fstrsolid%output_ctrl(3)%outinfo%on(4) ) then
461  id = hecmw_result_dtype_node
462  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(4), ndof )
463  label = 'NodalSTRESS'//trim(clyr)
464  call hecmw_result_add( id, nitem, label, res%STRESS )
465  endif
466 
467  ! --- MISES @node
468  if( fstrsolid%output_ctrl(3)%outinfo%on(5) ) then
469  id = hecmw_result_dtype_node
470  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(5), ndof )
471  label = 'NodalMISES'//trim(clyr)
472  call hecmw_result_add( id, nitem, label, res%MISES )
473  endif
474 
475  ! --- NODAL PRINC STRESS
476  if( fstrsolid%output_ctrl(3)%outinfo%on(19) ) then
477  id = hecmw_result_dtype_node
478  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(19), ndof )
479  label = 'NodalPrincipalSTRESS'//trim(clyr)
480  call hecmw_result_add( id, nitem, label, res%PSTRESS )
481  endif
482 
483  ! --- NODAL PRINC STRAIN
484  if( fstrsolid%output_ctrl(3)%outinfo%on(21) ) then
485  id = hecmw_result_dtype_node
486  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(21), ndof )
487  label = 'NodalPrincipalSTRAIN'//trim(clyr)
488  call hecmw_result_add( id, nitem, label, res%PSTRAIN )
489  endif
490 
491  ! --- NODAL PRINC STRESS VECTOR
492  if( fstrsolid%output_ctrl(3)%outinfo%on(23) ) then
493  id = hecmw_result_dtype_node
494  do k=1,3
495  write(cnum,'(i0)')k
496  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(23), ndof )
497  label = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
498  call hecmw_result_add( id, nitem, label, res%PSTRESS_VECT(:,k) )
499  end do
500  endif
501 
502  ! --- NODAL PRINC STRAIN VECTOR
503  if( fstrsolid%output_ctrl(3)%outinfo%on(25) ) then
504  id = hecmw_result_dtype_node
505  do k=1,3
506  write(cnum,'(i0)')k
507  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(25), ndof )
508  label = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
509  call hecmw_result_add( id, nitem, label, res%PSTRAIN_VECT(:,k) )
510  end do
511  endif
512 
513  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
514  ! --- STRAIN @element
515  if( fstrsolid%output_ctrl(3)%outinfo%on(6) ) then
516  id = hecmw_result_dtype_elem
517  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(6), ndof )
518  label = 'ElementalSTRAIN'//trim(clyr)
519  call hecmw_result_add( id, nitem, label, res%ESTRAIN )
520  endif
521 
522  ! --- STRESS @element
523  if( fstrsolid%output_ctrl(3)%outinfo%on(7) ) then
524  id = hecmw_result_dtype_elem
525  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(7), ndof )
526  label = 'ElementalSTRESS'//trim(clyr)
527  call hecmw_result_add( id, nitem, label, res%ESTRESS )
528  endif
529 
530  ! --- NQM @element
531  if( fstrsolid%output_ctrl(3)%outinfo%on(35) ) then
532  id = hecmw_result_dtype_elem
533  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(35), ndof )
534  label = 'ElementalNQM'//trim(clyr)
535  call hecmw_result_add( id, nitem, label, res%ENQM )
536  endif
537 
538  ! --- MISES @element
539  if( fstrsolid%output_ctrl(3)%outinfo%on(8)) then
540  id = hecmw_result_dtype_elem
541  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(8), ndof )
542  label = 'ElementalMISES'//trim(clyr)
543  call hecmw_result_add( id, nitem, label, res%EMISES )
544  endif
545 
546  ! --- Principal_STRESS @element
547  if( fstrsolid%output_ctrl(3)%outinfo%on(20) ) then
548  id = hecmw_result_dtype_elem
549  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(20), ndof )
550  label = 'ElementalPrincipalSTRESS'//trim(clyr)
551  call hecmw_result_add( id, nitem, label, res%EPSTRESS )
552  endif
553 
554  ! --- Principal_STRAIN @element
555  if( fstrsolid%output_ctrl(3)%outinfo%on(22) ) then
556  id = hecmw_result_dtype_elem
557  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(22), ndof )
558  label = 'ElementalPrincipalSTRAIN'//trim(clyr)
559  call hecmw_result_add( id, nitem, label, res%EPSTRAIN )
560  endif
561 
562  ! --- ELEM PRINC STRESS VECTOR
563  if( fstrsolid%output_ctrl(3)%outinfo%on(24) ) then
564  id = hecmw_result_dtype_elem
565  do k=1,3
566  write(cnum,'(i0)')k
567  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(24), ndof )
568  label = 'ElementalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
569  call hecmw_result_add( id, nitem, label, res%EPSTRESS_VECT(:,k) )
570  end do
571  endif
572 
573  !ELEM PRINC STRAIN VECTOR
574  if( fstrsolid%output_ctrl(3)%outinfo%on(26) ) then
575  id = hecmw_result_dtype_elem
576  do k=1,3
577  write(cnum,'(i0)')k
578  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(26), ndof )
579  label = 'ElementalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
580  call hecmw_result_add( id, nitem, label, res%EPSTRAIN_VECT(:,k) )
581  end do
582  endif
583 
584  ! --- PLASTIC STRAIN @element
585  if( fstrsolid%output_ctrl(3)%outinfo%on(43) ) then
586  id = 2
587  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(43), ndof )
588  ngauss = fstrsolid%maxn_gauss
589  label = 'ElementalPLSTRAIN'//trim(clyr)
590  do i = 1, hecmesh%n_elem
591  work(i) = 0.d0
592  do j = 1, size(fstrsolid%elements(i)%gausses)
593  work(i) = work(i) + fstrsolid%elements(i)%gausses(j)%plstrain
594  enddo
595  work(i) = work(i) / size(fstrsolid%elements(i)%gausses)
596  res%EPLSTRAIN(i) = work(i)
597  enddo
598  call hecmw_result_add( id, nitem, label, work )
599  endif
600  deallocate( work )
601 
602  end subroutine fstr_write_result_main
603 
604  !C***
606  !C***
607  subroutine fstr_make_result( hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC )
608  use m_fstr
609  use hecmw_util
610 
611  implicit none
612  type (hecmwst_local_mesh) :: hecmesh
613  type (fstr_solid) :: fstrsolid
614  type(hecmwst_result_data) :: fstrresult
615  integer(kind=kint) :: istep
616  real(kind=kreal) :: time
617  type(fstr_dynamic), intent(in), optional :: fstrdynamic
618  integer(kind=kint) :: n_lyr, ntot_lyr, it, coef33, is_33shell, is_33beam
619  integer(kind=kint) :: i, j, k, ndof, mdof, gcomp, gitem, ncomp, nitem, iitem, ecomp, eitem, jitem, nn, mm
620  integer(kind=kint) :: idx
621  real(kind=kreal), pointer :: tnstrain(:), testrain(:)
622  real(kind=kreal), allocatable ::unode(:)
623  character(len=4) :: cnum
624  character(len=6), allocatable :: clyr(:)
625  logical :: is_dynamic
626 
627  is_dynamic = present(fstrdynamic)
628 
629  tnstrain => fstrsolid%TNSTRAIN
630  testrain => fstrsolid%TESTRAIN
631 
632  ntot_lyr = fstrsolid%max_lyr
633  is_33shell = fstrsolid%is_33shell
634  is_33beam = fstrsolid%is_33beam
635 
636  mm = hecmesh%n_node
637  if( hecmesh%n_elem>hecmesh%n_node ) mm = hecmesh%n_elem
638 
639  if( is_dynamic ) then
640  idx = 1
641  if( fstrdynamic%idx_eqa==1 .and. istep>0 ) idx = 2
642  endif
643 
644  ndof = hecmesh%n_dof
645  if( ndof==2 ) mdof = 3
646  if( ndof==3 ) mdof = 6
647  if( ndof==4 ) mdof = 6
648  if( ndof==6 ) mdof = 6
649 
650  if(is_33shell == 1 .and. fstrsolid%output_ctrl(4)%outinfo%on(27) )then
651  coef33 = 1 + 2*ntot_lyr
652  else
653  coef33 = 1
654  endif
655 
656  call hecmw_nullify_result_data( fstrresult )
657  gcomp = 0
658  gitem = 0
659  ncomp = 0
660  nitem = 0
661  ecomp = 0
662  eitem = 0
663 
664  ! --- COUNT SUM OF ALL NITEM
665  ! --- TIME
666  gcomp = gcomp + 1
667  gitem = gitem + 1
668  ! --- DISPLACEMENT
669  if( fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
670  if(ndof == 4) then
671  ncomp = ncomp + 1
672  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
673  ncomp = ncomp + 1
674  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
675  else if(ndof == 6) then
676  ncomp = ncomp + 1
677  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
678  else
679  ncomp = ncomp + 1
680  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
681  endif
682  endif
683  ! --- VELOCITY
684  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
685  ncomp = ncomp + 1
686  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
687  endif
688  ! --- ACCELERATION
689  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
690  ncomp = ncomp + 1
691  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
692  endif
693  ! --- TEMPERATURE @node
694  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature) ) then
695  ncomp = ncomp + 1
696  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
697  endif
698  ! --- ROTATION (Only for 781 shell)
699  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
700  if(ndof == 6) then
701  ncomp = ncomp + 1
702  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), 3 )
703  else
704  if( is_33shell == 1 ) then
705  ncomp = ncomp + 1
706  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), ndof )
707  endif
708  endif
709  endif
710  ! --- REACTION FORCE
711  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
712  ncomp = ncomp + 1
713  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
714  endif
715  ! --- STRAIN @node
716  if( fstrsolid%output_ctrl(4)%outinfo%on(3) ) then
717  ncomp = ncomp + 1*coef33
718  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )*coef33
719  endif
720  ! --- STRESS @node
721  if( fstrsolid%output_ctrl(4)%outinfo%on(4) ) then
722  ncomp = ncomp + 1*coef33
723  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )*coef33
724  endif
725  ! --- MISES @node
726  if( fstrsolid%output_ctrl(4)%outinfo%on(5) ) then
727  ncomp = ncomp + 1*coef33
728  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )*coef33
729  endif
730  ! --- Principal Stress @node
731  if( fstrsolid%output_ctrl(4)%outinfo%on(19) ) then
732  ncomp = ncomp + 1*coef33
733  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )*coef33
734  endif
735  ! --- Principal Strain @node
736  if( fstrsolid%output_ctrl(4)%outinfo%on(21) ) then
737  ncomp = ncomp + 1*coef33
738  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )*coef33
739  endif
740  ! --- Principal Stress Vector @node
741  if( fstrsolid%output_ctrl(4)%outinfo%on(23) ) then
742  ncomp = ncomp + 3*coef33
743  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )*coef33
744  endif
745  ! --- Principal Strain Vector @node
746  if( fstrsolid%output_ctrl(4)%outinfo%on(25) ) then
747  ncomp = ncomp + 3*coef33
748  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )*coef33
749  endif
750  ! --- THERMAL STRAIN @node
751  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
752  ncomp = ncomp + 1
753  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
754  endif
755  ! --- CONTACT NORMAL FORCE @node
756  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
757  ncomp = ncomp + 1
758  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
759  endif
760  ! --- CONTACT FRICTION FORCE @node
761  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
762  ncomp = ncomp + 1
763  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
764  endif
765  ! --- CONTACT RELATIVE VELOCITY @node
766  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
767  ncomp = ncomp + 1
768  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
769  endif
770  ! --- CONTACT STATE @node
771  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
772  ncomp = ncomp + 1
773  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
774  endif
775  ! --- CONTACT NORMAL TRACTION @node
776  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
777  ncomp = ncomp + 1
778  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
779  endif
780  ! --- CONTACT FRICTION TRACTION @node
781  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
782  ncomp = ncomp + 1
783  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
784  endif
785  ! --- NODE ID @node
786  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
787  ncomp = ncomp + 1
788  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
789  endif
790  ! --- TEMPERATURE @node
791  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
792  ! ncomp = ncomp + 1
793  ! nitem = nitem + n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
794  !endif
795 
796  ! --- STRAIN @element
797  if( fstrsolid%output_ctrl(4)%outinfo%on(6) ) then
798  ecomp = ecomp + 1
799  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
800  endif
801  ! --- STRESS @element
802  if( fstrsolid%output_ctrl(4)%outinfo%on(7) ) then
803  ecomp = ecomp + 1
804  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
805  endif
806  ! --- MISES @element
807  if( fstrsolid%output_ctrl(4)%outinfo%on(8) ) then
808  ecomp = ecomp + 1
809  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
810  endif
811  ! --- Principal Stress @element
812  if( fstrsolid%output_ctrl(4)%outinfo%on(20) ) then
813  ecomp = ecomp + 1
814  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
815  endif
816  ! --- Principal Strain @element
817  if( fstrsolid%output_ctrl(4)%outinfo%on(22) ) then
818  ecomp = ecomp + 1
819  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
820  endif
821  ! --- Principal Stress Vector @element
822  if( fstrsolid%output_ctrl(4)%outinfo%on(24) ) then
823  ecomp = ecomp + 3
824  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
825  endif
826  ! --- Principal Strain Vector @element
827  if( fstrsolid%output_ctrl(4)%outinfo%on(26) ) then
828  ecomp = ecomp + 3
829  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
830  endif
831  ! --- PLASTIC STRAIN @element
832  if( fstrsolid%output_ctrl(4)%outinfo%on(43) ) then
833  ecomp = ecomp + 1
834  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
835  endif
836  ! --- MATERIAL @element
837  if( fstrsolid%output_ctrl(4)%outinfo%on(34) ) then
838  ecomp = ecomp + 1
839  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
840  endif
841  ! --- ELEM ID @element
842  if( fstrsolid%output_ctrl(4)%outinfo%on(39) ) then
843  ecomp = ecomp + 1
844  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
845  endif
846  ! --- SECTION ID @element
847  if( fstrsolid%output_ctrl(4)%outinfo%on(40) ) then
848  ecomp = ecomp + 1
849  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
850  endif
851 
852  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
853  fstrresult%ng_component = gcomp
854  fstrresult%nn_component = ncomp
855  fstrresult%ne_component = ecomp
856  allocate( fstrresult%ng_dof(gcomp) )
857  allocate( fstrresult%global_label(gcomp) )
858  allocate( fstrresult%global_val_item(gitem) )
859  allocate( fstrresult%nn_dof(ncomp) )
860  allocate( fstrresult%node_label(ncomp) )
861  allocate( fstrresult%node_val_item(nitem*hecmesh%n_node) )
862  allocate( fstrresult%ne_dof(ecomp) )
863  allocate( fstrresult%elem_label(ecomp) )
864  allocate( fstrresult%elem_val_item(eitem*hecmesh%n_elem) )
865  ncomp = 0
866  iitem = 0
867  ecomp = 0
868  jitem = 0
869 
870  ! --- TIME
871  fstrresult%ng_dof(1) = 1
872  fstrresult%global_label(1) = "TOTALTIME"
873  fstrresult%global_val_item(1) = time
874 
875  ! --- DISPLACEMENT
876  if (fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
877  if(ndof == 4) then
878  ! DIPLACEMENT
879  ncomp = ncomp + 1
880  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
881  fstrresult%nn_dof(ncomp) = nn
882  fstrresult%node_label(ncomp) = 'VELOCITY'
883  do i = 1, hecmesh%n_node
884  do j = 1, 3
885  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%DISP(4*(i-1)+j,idx)
886  enddo
887  enddo
888  iitem = iitem + nn
889  ! PRESSURE
890  ncomp = ncomp + 1
891  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
892  fstrresult%nn_dof(ncomp) = nn
893  fstrresult%node_label(ncomp) = 'PRESSURE'
894  do i = 1, hecmesh%n_node
895  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = fstrdynamic%DISP(4*i,idx)
896  enddo
897  iitem = iitem + nn
898  else if(ndof == 6) then
899  ncomp = ncomp + 1
900  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
901  fstrresult%nn_dof(ncomp) = nn
902  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
903  allocate( unode(3*hecmesh%n_node) )
904  unode = 0.0d0
905  if( is_dynamic ) then
906  do i=1, hecmesh%n_node
907  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
908  enddo
909  else
910  do i=1, hecmesh%n_node
911  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
912  enddo
913  endif
914  do i = 1, hecmesh%n_node
915  do j = 1, nn
916  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
917  enddo
918  enddo
919  deallocate( unode )
920  iitem = iitem + nn
921 
922  else
923  ncomp = ncomp + 1
924  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
925  fstrresult%nn_dof(ncomp) = nn
926  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
927  allocate( unode(ndof*hecmesh%n_node) )
928  unode = 0.0d0
929  if( is_dynamic ) then
930  unode(:) = fstrdynamic%DISP(:,idx)
931  else
932  unode(:) = fstrsolid%unode(:)
933  endif
934  if(is_33beam == 1)then
935  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
936  endif
937  if(is_33shell == 1)then
938  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
939  endif
940  do i = 1, hecmesh%n_node
941  do j = 1, nn
942  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
943  enddo
944  enddo
945  deallocate( unode )
946  iitem = iitem + nn
947  endif
948  endif
949 
950  ! --- VELOCITY
951  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
952  ncomp = ncomp + 1
953  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
954  fstrresult%nn_dof(ncomp) = nn
955  fstrresult%node_label(ncomp) = 'VELOCITY'
956  do i = 1, hecmesh%n_node
957  do j = 1, nn
958  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%VEL(nn*(i-1)+j,idx)
959  enddo
960  enddo
961  iitem = iitem + nn
962  endif
963 
964  ! --- ACCELERATION
965  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
966  ncomp = ncomp + 1
967  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
968  fstrresult%nn_dof(ncomp) = nn
969  fstrresult%node_label(ncomp) = 'ACCELERATION'
970  do i = 1, hecmesh%n_node
971  do j = 1, nn
972  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%ACC(nn*(i-1)+j,idx)
973  enddo
974  enddo
975  iitem = iitem + nn
976  endif
977 
978  ! --- TEMPERATURE
979  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature))then
980  ncomp = ncomp + 1
981  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
982  fstrresult%nn_dof(ncomp) = nn
983  fstrresult%node_label(ncomp) = 'TEMPERATURE'
984  do i = 1, hecmesh%n_node
985  do j = 1, nn
986  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%temperature(nn*(i-1)+j)
987  enddo
988  enddo
989  iitem = iitem + nn
990  endif
991 
992  ! --- ROTATION
993  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
994 
995  if(ndof == 6) then
996  ncomp = ncomp + 1
997  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
998  fstrresult%nn_dof(ncomp) = nn
999  fstrresult%node_label(ncomp) = 'ROTATION'
1000  allocate( unode(3*hecmesh%n_node) )
1001  unode = 0.0d0
1002  if( is_dynamic ) then
1003  do i=1, hecmesh%n_node
1004  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
1005  enddo
1006  else
1007  do i=1, hecmesh%n_node
1008  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
1009  enddo
1010  endif
1011  do i = 1, hecmesh%n_node
1012  do j = 1, nn
1013  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1014  enddo
1015  enddo
1016  deallocate( unode )
1017  iitem = iitem + nn
1018  else
1019  if ( is_33shell == 1) then
1020  ncomp = ncomp + 1
1021  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
1022  fstrresult%nn_dof(ncomp) = nn
1023  fstrresult%node_label(ncomp) = 'ROTATION'
1024  allocate( unode(ndof*hecmesh%n_node) )
1025  unode = 0.0d0
1026  call fstr_reorder_rot_shell(fstrsolid, hecmesh, unode)
1027  do i = 1, hecmesh%n_node
1028  do j = 1, nn
1029  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1030  enddo
1031  enddo
1032  deallocate( unode )
1033  iitem = iitem + nn
1034  end if
1035  end if
1036  endif
1037 
1038  ! --- REACTION FORCE
1039  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
1040  ncomp = ncomp + 1
1041  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
1042  fstrresult%nn_dof(ncomp) = nn
1043  fstrresult%node_label(ncomp) = 'REACTION_FORCE'
1044  do i = 1, hecmesh%n_node
1045  do j = 1, nn
1046  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%REACTION(nn*(i-1)+j)
1047  enddo
1048  enddo
1049  iitem = iitem + nn
1050  endif
1051  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1052  if(is_33shell == 1 .or. ndof == 6)then
1053  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1054  & fstrsolid%SHELL, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1055  else
1056  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1057  & fstrsolid%SOLID, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1058  endif
1059 
1060  !laminated shell
1061  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(4)%outinfo%on(27) .and. is_33shell == 1 ) then
1062  allocate(clyr(2*ntot_lyr))
1063  do i=1,ntot_lyr
1064  write(cnum,"(i0)")i
1065  clyr(2*i-1)="_L"//trim(cnum)//"+"
1066  clyr(2*i )="_L"//trim(cnum)//"-"
1067  enddo
1068  do i=1,ntot_lyr
1069  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1070  & fstrsolid%SHELL%LAYER(i)%PLUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i-1) )
1071  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1072  & fstrsolid%SHELL%LAYER(i)%MINUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i ) )
1073  enddo
1074  deallocate(clyr)
1075  endif
1076 
1077  ! --- THERMAL STRAIN @node
1078  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
1079  ncomp = ncomp + 1
1080  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
1081  fstrresult%nn_dof(ncomp) = nn
1082  fstrresult%node_label(ncomp) = 'THERMAL_NodalSTRAIN'
1083  do i = 1, hecmesh%n_node
1084  do j = 1, nn
1085  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = tnstrain(nn*(i-1)+j)
1086  enddo
1087  enddo
1088  iitem = iitem + nn
1089  endif
1090 
1091  ! --- CONTACT NORMAL FORCE @node
1092  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1093  ncomp = ncomp + 1
1094  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
1095  fstrresult%nn_dof(ncomp) = nn
1096  fstrresult%node_label(ncomp) = 'CONTACT_NFORCE'
1097  do i = 1, hecmesh%n_node
1098  do j = 1, nn
1099  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NFORCE(nn*(i-1)+j)
1100  enddo
1101  enddo
1102  iitem = iitem + nn
1103  endif
1104 
1105  ! --- CONTACT FRICTION FORCE @node
1106  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1107  ncomp = ncomp + 1
1108  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
1109  fstrresult%nn_dof(ncomp) = nn
1110  fstrresult%node_label(ncomp) = 'CONTACT_FRICTION'
1111  do i = 1, hecmesh%n_node
1112  do j = 1, nn
1113  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FRIC(nn*(i-1)+j)
1114  enddo
1115  enddo
1116  iitem = iitem + nn
1117  endif
1118 
1119  ! --- CONTACT RELATIVE VELOCITY @node
1120  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1121  ncomp = ncomp + 1
1122  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
1123  fstrresult%nn_dof(ncomp) = nn
1124  fstrresult%node_label(ncomp) = 'CONTACT_RELVEL'
1125  do i = 1, hecmesh%n_node
1126  do j = 1, nn
1127  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_RELVEL(nn*(i-1)+j)
1128  enddo
1129  enddo
1130  iitem = iitem + nn
1131  endif
1132 
1133  ! --- CONTACT STATE @node
1134  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1135  ncomp = ncomp + 1
1136  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
1137  fstrresult%nn_dof(ncomp) = nn
1138  fstrresult%node_label(ncomp) = 'CONTACT_STATE'
1139  do i = 1, hecmesh%n_node
1140  do j = 1, nn
1141  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_STATE(nn*(i-1)+j)
1142  enddo
1143  enddo
1144  iitem = iitem + nn
1145  endif
1146 
1147  ! --- CONTACT NORMAL TRACTION @node
1148  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1149  ncomp = ncomp + 1
1150  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
1151  fstrresult%nn_dof(ncomp) = nn
1152  fstrresult%node_label(ncomp) = 'CONTACT_NTRACTION'
1153  do i = 1, hecmesh%n_node
1154  do j = 1, nn
1155  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NTRAC(nn*(i-1)+j)
1156  enddo
1157  enddo
1158  iitem = iitem + nn
1159  endif
1160 
1161  ! --- CONTACT FRICTION TRACTION @node
1162  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1163  ncomp = ncomp + 1
1164  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
1165  fstrresult%nn_dof(ncomp) = nn
1166  fstrresult%node_label(ncomp) = 'CONTACT_FTRACTION'
1167  do i = 1, hecmesh%n_node
1168  do j = 1, nn
1169  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FTRAC(nn*(i-1)+j)
1170  enddo
1171  enddo
1172  iitem = iitem + nn
1173  endif
1174 
1175  ! --- NODE ID @node
1176  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
1177  ncomp = ncomp + 1
1178  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
1179  fstrresult%nn_dof(ncomp) = nn
1180  fstrresult%node_label(ncomp) = 'NODE_ID'
1181  do i = 1, hecmesh%n_node
1182  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = hecmesh%global_node_ID(i)
1183  enddo
1184  iitem = iitem + nn
1185  endif
1186 
1187  ! --- TEMPERATURE @node
1188  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
1189  ! ncomp = ncomp + 1
1190  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
1191  ! fstrRESULT%nn_dof(ncomp) = nn
1192  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
1193  ! do i = 1, hecMESH%n_node
1194  ! fstrRESULT%node_val_item(nitem*(i-1)+1+iitem) = fstrSOLID%global_node_ID(i)
1195  ! enddo
1196  ! iitem = iitem + nn
1197  !endif
1198 
1199 
1200  ! --- MATERIAL @elem
1201  if(fstrsolid%output_ctrl(4)%outinfo%on(34)) then
1202  ecomp = ecomp + 1
1203  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
1204  fstrresult%ne_dof(ecomp) = nn
1205  fstrresult%elem_label(ecomp) = 'MATERIAL_ID'
1206  do i = 1, hecmesh%n_elem
1207  j = hecmesh%section_ID(i)
1208  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section%sect_mat_ID_item(j)
1209  enddo
1210  jitem = jitem + nn
1211  endif
1212 
1213  ! --- ELEM ID @elem
1214  if(fstrsolid%output_ctrl(4)%outinfo%on(39)) then
1215  ecomp = ecomp + 1
1216  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
1217  fstrresult%ne_dof(ecomp) = nn
1218  fstrresult%elem_label(ecomp) = 'ELEM_ID'
1219  do i = 1, hecmesh%n_elem
1220  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%global_elem_ID(i)
1221  enddo
1222  jitem = jitem + nn
1223  endif
1224 
1225  ! --- SECTION ID @elem
1226  if(fstrsolid%output_ctrl(4)%outinfo%on(40)) then
1227  ecomp = ecomp + 1
1228  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
1229  fstrresult%ne_dof(ecomp) = nn
1230  fstrresult%elem_label(ecomp) = 'SECTION_ID'
1231  do i = 1, hecmesh%n_elem
1232  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section_ID(i)
1233  enddo
1234  jitem = jitem + nn
1235  endif
1236  end subroutine fstr_make_result
1237 
1238  subroutine fstr_make_result_main( hecMESH, fstrSOLID, fstrRESULT, RES, nitem, &
1239  & iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr )
1240  use m_fstr
1241  use m_out
1242  use m_static_lib
1243  use mmaterial
1244  use hecmw_util
1245 
1246  implicit none
1247  type (hecmwST_local_mesh) :: hecMESH
1248  type (fstr_solid) :: fstrSOLID
1249  type (hecmwST_result_data):: fstrRESULT
1250  type (fstr_solid_physic_val) :: RES
1251  integer(kind=kint) :: istep, flag
1252  integer(kind=kint) :: n_lyr, cid
1253 
1254  character(len=HECMW_HEADER_LEN) :: header
1255  character(len=HECMW_NAME_LEN) :: s, label, nameID, addfname
1256  character(len=6) :: clyr
1257  character(len=4) :: cnum
1258  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, eitem, nn, mm, ngauss, it
1259  integer(kind=kint) :: iitem, ncomp, jitem, ecomp, nlyr
1260 
1261  ndof = hecmesh%n_dof
1262 
1263  ! --- STRAIN @node
1264  if( fstrsolid%output_ctrl(4)%outinfo%on(3)) then
1265  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )
1266  ncomp = ncomp + 1
1267  fstrresult%nn_dof(ncomp) = nn
1268  fstrresult%node_label(ncomp) = 'NodalSTRAIN'//trim(clyr)
1269  do i = 1, hecmesh%n_node
1270  do j = 1, nn
1271  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRAIN(nn*(i-1)+j)
1272  enddo
1273  enddo
1274  iitem = iitem + nn
1275  endif
1276 
1277  ! --- STRESS @node
1278  if(fstrsolid%output_ctrl(4)%outinfo%on(4)) then
1279  ncomp = ncomp + 1
1280  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )
1281  fstrresult%nn_dof(ncomp) = nn
1282  fstrresult%node_label(ncomp) = 'NodalSTRESS'//trim(clyr)
1283  do i = 1, hecmesh%n_node
1284  do j = 1, nn
1285  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRESS((nn)*(i-1)+j)
1286  enddo
1287  enddo
1288  iitem = iitem + nn
1289  endif
1290 
1291  ! --- MISES @node
1292  if(fstrsolid%output_ctrl(4)%outinfo%on(5)) then
1293  ncomp = ncomp + 1
1294  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )
1295  fstrresult%nn_dof(ncomp) = nn
1296  fstrresult%node_label(ncomp) = 'NodalMISES'//trim(clyr)
1297  do i = 1, hecmesh%n_node
1298  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = res%MISES(i)
1299  enddo
1300  iitem = iitem + nn
1301  endif
1302 
1303  ! --- Princ STRESS @node
1304  if(fstrsolid%output_ctrl(4)%outinfo%on(19)) then
1305  ncomp = ncomp + 1
1306  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )
1307  fstrresult%nn_dof(ncomp) = nn
1308  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESS'//trim(clyr)
1309  do i = 1, hecmesh%n_node
1310  do j = 1, nn
1311  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS((nn)*(i-1)+j)
1312  enddo
1313  enddo
1314  iitem = iitem + nn
1315  endif
1316 
1317  ! --- Princ STRESS Vector @node
1318  if(fstrsolid%output_ctrl(4)%outinfo%on(23)) then
1319  do k=1,3
1320  write(cnum, '(i0)') k
1321  ncomp = ncomp + 1
1322  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )
1323  fstrresult%nn_dof(ncomp) = nn
1324  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
1325  do i = 1, hecmesh%n_node
1326  do j = 1, nn
1327  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS_VECT((nn)*(i-1)+j,k)
1328  enddo
1329  enddo
1330  iitem = iitem + nn
1331  end do
1332  endif
1333 
1334  ! --- Princ STRAIN @node
1335  if( fstrsolid%output_ctrl(4)%outinfo%on(21)) then
1336  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )
1337  ncomp = ncomp + 1
1338  fstrresult%nn_dof(ncomp) = nn
1339  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAIN'//trim(clyr)
1340  do i = 1, hecmesh%n_node
1341  do j = 1, nn
1342  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN(nn*(i-1)+j)
1343  enddo
1344  enddo
1345  iitem = iitem + nn
1346  endif
1347 
1348  ! --- Princ STRAIN Vector @node
1349  if( fstrsolid%output_ctrl(4)%outinfo%on(25)) then
1350  do k=1,3
1351  write(cnum, '(i0)') k
1352  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )
1353  ncomp = ncomp + 1
1354  fstrresult%nn_dof(ncomp) = nn
1355  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
1356  do i = 1, hecmesh%n_node
1357  do j = 1, nn
1358  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN_VECT(nn*(i-1)+j,k)
1359  enddo
1360  enddo
1361  iitem = iitem + nn
1362  enddo
1363  endif
1364 
1365  ! --- STRAIN @elem
1366  if( fstrsolid%output_ctrl(4)%outinfo%on(6)) then
1367  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
1368  ecomp = ecomp + 1
1369  fstrresult%ne_dof(ecomp) = nn
1370  fstrresult%elem_label(ecomp) = 'ElementalSTRAIN'
1371  do i = 1, hecmesh%n_elem
1372  do j = 1, nn
1373  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRAIN(nn*(i-1)+j)
1374  enddo
1375  enddo
1376  jitem = jitem + nn
1377  endif
1378 
1379  ! --- STRESS @elem
1380  if(fstrsolid%output_ctrl(4)%outinfo%on(7)) then
1381  ecomp = ecomp + 1
1382  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
1383  fstrresult%ne_dof(ecomp) = nn
1384  fstrresult%elem_label(ecomp) = 'ElementalSTRESS'
1385  do i = 1, hecmesh%n_elem
1386  do j = 1, nn
1387  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRESS((nn)*(i-1)+j)
1388  enddo
1389  enddo
1390  jitem = jitem + nn
1391  endif
1392 
1393  ! --- MISES @elem
1394  if(fstrsolid%output_ctrl(4)%outinfo%on(8)) then
1395  ecomp = ecomp + 1
1396  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
1397  fstrresult%ne_dof(ecomp) = nn
1398  fstrresult%elem_label(ecomp) = 'ElementalMISES'
1399  do i = 1, hecmesh%n_elem
1400  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EMISES(i)
1401  enddo
1402  jitem = jitem + nn
1403  endif
1404 
1405  ! --- Principal_STRESS @element
1406  if(fstrsolid%output_ctrl(4)%outinfo%on(20)) then
1407  ecomp = ecomp + 1
1408  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
1409  fstrresult%ne_dof(ecomp) = nn
1410  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESS'
1411  do i = 1, hecmesh%n_elem
1412  do j = 1, nn
1413  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS((nn)*(i-1)+j)
1414  enddo
1415  enddo
1416  jitem = jitem + nn
1417  endif
1418 
1419  ! --- Principal_STRAIN @element
1420  if(fstrsolid%output_ctrl(4)%outinfo%on(22)) then
1421  ecomp = ecomp + 1
1422  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
1423  fstrresult%ne_dof(ecomp) = nn
1424  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAIN'
1425  do i = 1, hecmesh%n_elem
1426  do j = 1, nn
1427  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN((nn)*(i-1)+j)
1428  enddo
1429  enddo
1430  jitem = jitem + nn
1431  endif
1432 
1433  ! --- ELEM PRINC STRESS VECTOR
1434  if(fstrsolid%output_ctrl(4)%outinfo%on(24)) then
1435  do k = 1, 3
1436  write(cnum,'(i0)')k
1437  ecomp = ecomp + 1
1438  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
1439  fstrresult%ne_dof(ecomp) = nn
1440  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESSVector'//trim(cnum)
1441  do i = 1, hecmesh%n_elem
1442  do j = 1, nn
1443  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS_VECT((nn)*(i-1)+j,k)
1444  enddo
1445  enddo
1446  jitem = jitem + nn
1447  enddo
1448  endif
1449 
1450  ! --- ELEM PRINC STRAIN VECTOR
1451  if(fstrsolid%output_ctrl(4)%outinfo%on(26)) then
1452  do k = 1, 3
1453  write(cnum,'(i0)')k
1454  ecomp = ecomp + 1
1455  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
1456  fstrresult%ne_dof(ecomp) = nn
1457  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAINVector'//trim(cnum)
1458  do i = 1, hecmesh%n_elem
1459  do j = 1, nn
1460  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN_VECT((nn)*(i-1)+j,k)
1461  enddo
1462  enddo
1463  jitem = jitem + nn
1464  enddo
1465  endif
1466 
1467  ! --- PLSTRAIN @elem
1468  if(fstrsolid%output_ctrl(4)%outinfo%on(43)) then
1469  ecomp = ecomp + 1
1470  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
1471  fstrresult%ne_dof(ecomp) = nn
1472  fstrresult%elem_label(ecomp) = 'ElementalPLSTRAIN'
1473  do i = 1, hecmesh%n_elem
1474  res%EPLSTRAIN(i) = 0.d0
1475  do j = 1, size(fstrsolid%elements(i)%gausses)
1476  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) + fstrsolid%elements(i)%gausses(j)%plstrain
1477  enddo
1478  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) / size(fstrsolid%elements(i)%gausses)
1479  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EPLSTRAIN(i)
1480  enddo
1481  jitem = jitem + nn
1482  endif
1483 
1484  end subroutine fstr_make_result_main
1485 
1486  subroutine fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
1487  use m_fstr
1488  use m_out
1489  use m_static_lib
1490 
1491  implicit none
1492  type (fstr_solid) :: fstrsolid
1493  type (hecmwst_local_mesh) :: hecmesh
1494  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1495  integer(kind=kint) :: mm, n1, n2
1496  real(kind=kreal), allocatable :: unode(:)
1497 
1498  do itype = 1, hecmesh%n_elem_type
1499  is = hecmesh%elem_type_index(itype-1) + 1
1500  ie = hecmesh%elem_type_index(itype )
1501  ic_type = hecmesh%elem_type_item(itype)
1502  if(ic_type == 781)then
1503  do icel = is, ie
1504  js = hecmesh%elem_node_index(icel-1)
1505  do j = 1, 4
1506  n1 = hecmesh%elem_node_item(js+j )
1507  n2 = hecmesh%elem_node_item(js+j+4)
1508  unode(3*n2-2) = unode(3*n1-2)
1509  unode(3*n2-1) = unode(3*n1-1)
1510  unode(3*n2 ) = unode(3*n1 )
1511  enddo
1512  enddo
1513  elseif(ic_type == 761)then
1514  do icel = is, ie
1515  js = hecmesh%elem_node_index(icel-1)
1516  do j = 1, 3
1517  n1 = hecmesh%elem_node_item(js+j )
1518  n2 = hecmesh%elem_node_item(js+j+3)
1519  unode(3*n2-2) = unode(3*n1-2)
1520  unode(3*n2-1) = unode(3*n1-1)
1521  unode(3*n2 ) = unode(3*n1 )
1522  enddo
1523  enddo
1524  endif
1525  enddo
1526 
1527  end subroutine fstr_reorder_node_shell
1528 
1529  subroutine fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
1530  use m_fstr
1531  use m_out
1532  use m_static_lib
1533 
1534  implicit none
1535  type (fstr_solid) :: fstrsolid
1536  type (hecmwst_local_mesh) :: hecmesh
1537  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1538  integer(kind=kint) :: mm, n1, n2
1539  real(kind=kreal), allocatable :: unode(:)
1540 
1541  do itype = 1, hecmesh%n_elem_type
1542  is = hecmesh%elem_type_index(itype-1) + 1
1543  ie = hecmesh%elem_type_index(itype )
1544  ic_type = hecmesh%elem_type_item(itype)
1545  if(ic_type == 781)then
1546  do icel = is, ie
1547  js = hecmesh%elem_node_index(icel-1)
1548  do j = 1, 4
1549  n1 = hecmesh%elem_node_item(js+j)
1550  n2 = hecmesh%elem_node_item(js+j+4)
1551  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1552  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1553  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1554  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1555  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1556  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1557  enddo
1558  enddo
1559  elseif(ic_type == 761)then
1560  do icel = is, ie
1561  js = hecmesh%elem_node_index(icel-1)
1562  do j = 1, 3
1563  n1 = hecmesh%elem_node_item(js+j)
1564  n2 = hecmesh%elem_node_item(js+j+3)
1565 
1566  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1567  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1568  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1569  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1570  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1571  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1572  enddo
1573  enddo
1574  endif
1575  enddo
1576 
1577  end subroutine fstr_reorder_rot_shell
1578 
1579  subroutine fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
1580  use m_fstr
1581  use m_out
1582  use m_static_lib
1583 
1584  implicit none
1585  type (fstr_solid) :: fstrsolid
1586  type (hecmwst_local_mesh) :: hecmesh
1587  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1588  integer(kind=kint) :: mm, a, b
1589  real(kind=kreal), allocatable :: unode(:)
1590 
1591  do itype = 1, hecmesh%n_elem_type
1592  is = hecmesh%elem_type_index(itype-1) + 1
1593  ie = hecmesh%elem_type_index(itype )
1594  ic_type = hecmesh%elem_type_item(itype)
1595  if(ic_type == 641)then
1596  do icel = is, ie
1597  js = hecmesh%elem_node_index(icel-1)
1598  do j = 1, 2
1599  a = hecmesh%elem_node_item(js+j)
1600  b = hecmesh%elem_node_item(js+j+2)
1601  unode(3*b-2) = unode(3*a-2)
1602  unode(3*b-1) = unode(3*a-1)
1603  unode(3*b ) = unode(3*a )
1604  enddo
1605  enddo
1606  endif
1607  enddo
1608 
1609  end subroutine fstr_reorder_node_beam
1610 
1611  subroutine setup_contact_output_variables( hecMESH, fstrSOLID, phase )
1612  use m_fstr
1613  use hecmw_util
1614  use mcontact
1615  implicit none
1616  type(hecmwst_local_mesh), intent(in) :: hecmesh
1617  type (fstr_solid), intent(inout) :: fstrsolid
1618  integer(kind=kint), intent(in) :: phase
1619 
1620  integer(kind=kint), parameter :: nval = 10
1621  logical, save :: updated(nval) = .false.
1622  integer(kind=kint) :: ndof, i
1623  real(kind=kreal) :: area
1624 
1625  ndof = hecmesh%n_dof
1626 
1627  if( phase == -1 ) then
1628  updated(1:nval) = .false.
1629  return
1630  else
1631  if( phase /= 3 .and. phase /= 4 ) return !irregular case
1632  end if
1633 
1634  ! --- CONTACT NORMAL FORCE @node
1635  if( fstrsolid%output_ctrl(phase)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1636  if( paracontactflag .and. .not. updated(1)) then
1637  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1638  end if
1639  updated(1) = .true.
1640  endif
1641 
1642  ! --- CONTACT FRICTION FORCE @node
1643  if( fstrsolid%output_ctrl(phase)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1644  if( paracontactflag .and. .not. updated(2)) then
1645  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1646  end if
1647  updated(2) = .true.
1648  endif
1649 
1650  ! --- CONTACT RELATIVE VELOCITY @node
1651  if( fstrsolid%output_ctrl(phase)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1652  if( paracontactflag .and. .not. updated(3)) then
1653  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_RELVEL,1)
1654  end if
1655  updated(3) = .true.
1656  endif
1657 
1658  ! --- CONTACT STATE @node
1659  if( fstrsolid%output_ctrl(phase)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1660  if( paracontactflag .and. .not. updated(4)) then
1661  call fstr_setup_parancon_contactvalue(hecmesh,1,fstrsolid%CONT_STATE,2)
1662  end if
1663  updated(4) = .true.
1664  endif
1665 
1666  ! --- CONTACT AREA for CONTACT TRACTION
1667  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .or. fstrsolid%output_ctrl(phase)%outinfo%on(37) ) then
1668  if( .not. updated(5)) call calc_contact_area( hecmesh, fstrsolid, 0 )
1669  ! fstr_setup_parancon_contactvalue is not necessary because
1670  ! contact area is calculated from original surface group
1671  end if
1672 
1673  ! --- CONTACT NORMAL TRACTION @node
1674  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1675  if( paracontactflag .and. .not. updated(6)) then
1676  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1677  end if
1678  fstrsolid%CONT_NTRAC(:) = 0.d0
1679  do i=1,hecmesh%nn_internal
1680  area = fstrsolid%CONT_AREA(i)
1681  if( area < 1.d-16 ) cycle
1682  fstrsolid%CONT_NTRAC(3*i-2:3*i) = fstrsolid%CONT_NFORCE(3*i-2:3*i)/area
1683  end do
1684  updated(6) = .true.
1685  endif
1686 
1687  ! --- CONTACT FRICTION TRACTION @node
1688  if( fstrsolid%output_ctrl(phase)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1689  if( paracontactflag .and. .not. updated(7)) then
1690  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1691  end if
1692  fstrsolid%CONT_FTRAC(:) = 0.d0
1693  do i=1,hecmesh%nn_internal
1694  area = fstrsolid%CONT_AREA(i)
1695  if( area < 1.d-16 ) cycle
1696  fstrsolid%CONT_FTRAC(3*i-2:3*i) = fstrsolid%CONT_FRIC(3*i-2:3*i)/area
1697  end do
1698  updated(7) = .true.
1699  endif
1700 
1701  end subroutine
1702 
1703 end module m_make_result
m_make_result::setup_contact_output_variables
subroutine, public setup_contact_output_variables(hecMESH, fstrSOLID, phase)
Definition: make_result.f90:1612
m_out
This module manages step information.
Definition: m_out.f90:6
m_make_result::fstr_write_result
subroutine, public fstr_write_result(hecMESH, fstrSOLID, fstrPARAM, istep, time, flag, fstrDYNAMIC)
OUTPUT result file for static and dynamic analysis.
Definition: make_result.f90:22
m_make_result::fstr_write_result_main
subroutine fstr_write_result_main(hecMESH, fstrSOLID, RES, clyr)
Definition: make_result.f90:428
m_make_result
This module provide a function to prepare output of static analysis.
Definition: make_result.f90:6
m_fstr::fstr_solid
Definition: m_fstr.f90:238
m_fstr::fstr_dynamic
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.f90:504
m_fstr::fstr_param
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.f90:154
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_util::hecmwst_local_mesh
Definition: hecmw_util_f.F90:234
m_out::n_comp_valtype
integer function n_comp_valtype(vtype, ndim)
Definition: m_out.f90:201
m_make_result::fstr_make_result
subroutine, public fstr_make_result(hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC)
MAKE RESULT for static and dynamic analysis (WITHOUT ELEMENTAL RESULTS) -----------------------------...
Definition: make_result.f90:608
m_make_result::fstr_reorder_node_beam
subroutine, public fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1580
mcontact::fstr_setup_parancon_contactvalue
subroutine fstr_setup_parancon_contactvalue(hecMESH, ndof, vec, vtype)
Definition: fstr_contact.f90:764
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.f90:15
hecmw_util::kreal
integer(kind=4), parameter kreal
Definition: hecmw_util_f.F90:16
m_make_result::fstr_make_result_main
subroutine fstr_make_result_main(hecMESH, fstrSOLID, fstrRESULT, RES, nitem, iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr)
Definition: make_result.f90:1240
m_fstr::paracontactflag
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.f90:100
mcontact::calc_contact_area
subroutine calc_contact_area(hecMESH, fstrSOLID, flag)
Definition: fstr_contact.f90:675
m_static_lib
This modules just summarizes all modules used in static analysis.
Definition: static_LIB.f90:6
m_make_result::fstr_reorder_node_shell
subroutine, public fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1487
mmaterial
This module summarizes all information of material properties.
Definition: material.f90:6
m_make_result::fstr_reorder_rot_shell
subroutine, public fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
Definition: make_result.f90:1530
mcontact
This module provides functions to calculate contact stiff matrix.
Definition: fstr_contact.f90:6