FrontISTR  5.9.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 !-------------------------------------------------------------------------------
7  private
8 
9  public:: fstr_write_result
10  public:: fstr_make_result
12  public:: fstr_reorder_rot_shell
13  public:: fstr_reorder_node_beam
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=16), 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  ! --- ELEMACT flag @element
413  if( fstrsolid%output_ctrl(3)%outinfo%on(44) ) then
414  id = hecmw_result_dtype_elem
415  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(44), ndof )
416  label = 'ELEMACT'
417  work(:) = 0.d0
418  do i = 1, hecmesh%n_elem
419  if( fstrsolid%elements(i)%elemact_flag /= kelact_inactive ) work(i) = 1.d0
420  enddo
421  call hecmw_result_add( id, nitem, label, work )
422  endif
423 
424  ! --- WRITE
425  nameid = 'fstrRES'
426  if( flag==0 ) then
427  call hecmw_result_write_by_name( nameid )
428  else
429  addfname = '_dif'
430  call hecmw_result_write_by_addfname( nameid, addfname )
431  endif
432 
433  ! --- FINALIZE
434  call hecmw_result_finalize
435 
436  deallocate( work )
437  end subroutine fstr_write_result
438 
439  subroutine fstr_write_result_main( hecMESH, fstrSOLID, RES, clyr )
440  use m_fstr
441  use m_out
442  use m_static_lib
443  use mmaterial
444  use hecmw_util
445 
446  implicit none
447  type (hecmwST_local_mesh) :: hecMESH
448  type (fstr_solid) :: fstrSOLID
449  type (fstr_solid_physic_val) :: RES
450  integer(kind=kint) :: istep, flag
451  integer(kind=kint) :: n_lyr, cid
452 
453  character(len=HECMW_HEADER_LEN) :: header
454  character(len=HECMW_NAME_LEN) :: s, label, nameID, addfname
455  character(len=16) :: clyr
456  character(len=12) :: cnum
457  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, nn, mm, ngauss, it
458  real(kind=kreal), allocatable :: work(:)
459 
460  ndof = hecmesh%n_dof
461  allocate( work(hecmesh%n_elem) )
462 
463  ! --- STRAIN @node
464  if (fstrsolid%output_ctrl(3)%outinfo%on(3)) then
465  id = hecmw_result_dtype_node
466  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(3), ndof )
467  label = 'NodalSTRAIN'//trim(clyr)
468  call hecmw_result_add( id, nitem, label, res%STRAIN )
469  endif
470 
471  ! --- STRESS @node
472  if( fstrsolid%output_ctrl(3)%outinfo%on(4) ) then
473  id = hecmw_result_dtype_node
474  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(4), ndof )
475  label = 'NodalSTRESS'//trim(clyr)
476  call hecmw_result_add( id, nitem, label, res%STRESS )
477  endif
478 
479  ! --- MISES @node
480  if( fstrsolid%output_ctrl(3)%outinfo%on(5) ) then
481  id = hecmw_result_dtype_node
482  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(5), ndof )
483  label = 'NodalMISES'//trim(clyr)
484  call hecmw_result_add( id, nitem, label, res%MISES )
485  endif
486 
487  ! --- NODAL PRINC STRESS
488  if( fstrsolid%output_ctrl(3)%outinfo%on(19) ) then
489  id = hecmw_result_dtype_node
490  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(19), ndof )
491  label = 'NodalPrincipalSTRESS'//trim(clyr)
492  call hecmw_result_add( id, nitem, label, res%PSTRESS )
493  endif
494 
495  ! --- NODAL PRINC STRAIN
496  if( fstrsolid%output_ctrl(3)%outinfo%on(21) ) then
497  id = hecmw_result_dtype_node
498  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(21), ndof )
499  label = 'NodalPrincipalSTRAIN'//trim(clyr)
500  call hecmw_result_add( id, nitem, label, res%PSTRAIN )
501  endif
502 
503  ! --- NODAL PRINC STRESS VECTOR
504  if( fstrsolid%output_ctrl(3)%outinfo%on(23) ) then
505  id = hecmw_result_dtype_node
506  do k=1,3
507  write(cnum,'(i0)')k
508  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(23), ndof )
509  label = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
510  call hecmw_result_add( id, nitem, label, res%PSTRESS_VECT(:,k) )
511  end do
512  endif
513 
514  ! --- NODAL PRINC STRAIN VECTOR
515  if( fstrsolid%output_ctrl(3)%outinfo%on(25) ) then
516  id = hecmw_result_dtype_node
517  do k=1,3
518  write(cnum,'(i0)')k
519  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(25), ndof )
520  label = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
521  call hecmw_result_add( id, nitem, label, res%PSTRAIN_VECT(:,k) )
522  end do
523  endif
524 
525  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
526  ! --- STRAIN @element
527  if( fstrsolid%output_ctrl(3)%outinfo%on(6) ) then
528  id = hecmw_result_dtype_elem
529  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(6), ndof )
530  label = 'ElementalSTRAIN'//trim(clyr)
531  call hecmw_result_add( id, nitem, label, res%ESTRAIN )
532  endif
533 
534  ! --- STRESS @element
535  if( fstrsolid%output_ctrl(3)%outinfo%on(7) ) then
536  id = hecmw_result_dtype_elem
537  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(7), ndof )
538  label = 'ElementalSTRESS'//trim(clyr)
539  call hecmw_result_add( id, nitem, label, res%ESTRESS )
540  endif
541 
542  ! --- NQM @element
543  if( fstrsolid%output_ctrl(3)%outinfo%on(35) ) then
544  id = hecmw_result_dtype_elem
545  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(35), ndof )
546  label = 'ElementalNQM'//trim(clyr)
547  call hecmw_result_add( id, nitem, label, res%ENQM )
548  endif
549 
550  ! --- MISES @element
551  if( fstrsolid%output_ctrl(3)%outinfo%on(8)) then
552  id = hecmw_result_dtype_elem
553  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(8), ndof )
554  label = 'ElementalMISES'//trim(clyr)
555  call hecmw_result_add( id, nitem, label, res%EMISES )
556  endif
557 
558  ! --- Principal_STRESS @element
559  if( fstrsolid%output_ctrl(3)%outinfo%on(20) ) then
560  id = hecmw_result_dtype_elem
561  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(20), ndof )
562  label = 'ElementalPrincipalSTRESS'//trim(clyr)
563  call hecmw_result_add( id, nitem, label, res%EPSTRESS )
564  endif
565 
566  ! --- Principal_STRAIN @element
567  if( fstrsolid%output_ctrl(3)%outinfo%on(22) ) then
568  id = hecmw_result_dtype_elem
569  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(22), ndof )
570  label = 'ElementalPrincipalSTRAIN'//trim(clyr)
571  call hecmw_result_add( id, nitem, label, res%EPSTRAIN )
572  endif
573 
574  ! --- ELEM PRINC STRESS VECTOR
575  if( fstrsolid%output_ctrl(3)%outinfo%on(24) ) then
576  id = hecmw_result_dtype_elem
577  do k=1,3
578  write(cnum,'(i0)')k
579  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(24), ndof )
580  label = 'ElementalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
581  call hecmw_result_add( id, nitem, label, res%EPSTRESS_VECT(:,k) )
582  end do
583  endif
584 
585  !ELEM PRINC STRAIN VECTOR
586  if( fstrsolid%output_ctrl(3)%outinfo%on(26) ) then
587  id = hecmw_result_dtype_elem
588  do k=1,3
589  write(cnum,'(i0)')k
590  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(26), ndof )
591  label = 'ElementalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
592  call hecmw_result_add( id, nitem, label, res%EPSTRAIN_VECT(:,k) )
593  end do
594  endif
595 
596  ! --- PLASTIC STRAIN @element
597  if( fstrsolid%output_ctrl(3)%outinfo%on(43) ) then
598  id = hecmw_result_dtype_elem
599  nitem = n_comp_valtype( fstrsolid%output_ctrl(3)%outinfo%vtype(43), ndof )
600  label = 'ElementalPLSTRAIN'//trim(clyr)
601  call hecmw_result_add( id, nitem, label, res%EPLSTRAIN )
602  endif
603  deallocate( work )
604 
605  end subroutine fstr_write_result_main
606 
607  !C***
609  !C***
610  subroutine fstr_make_result( hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC )
611  use m_fstr
612  use hecmw_util
613 
614  implicit none
615  type (hecmwst_local_mesh) :: hecmesh
616  type (fstr_solid) :: fstrsolid
617  type(hecmwst_result_data) :: fstrresult
618  integer(kind=kint) :: istep
619  real(kind=kreal) :: time, coords(3,3)
620  type(fstr_dynamic), intent(in), optional :: fstrdynamic
621  integer(kind=kint) :: n_lyr, ntot_lyr, it, coef33, is_33shell, is_33beam
622  integer(kind=kint) :: i, j, k, ndof, mdof, gcomp, gitem, ncomp, nitem, iitem, ecomp, eitem, jitem, nn, mm
623  integer(kind=kint) :: idx
624  real(kind=kreal), pointer :: tnstrain(:), testrain(:)
625  real(kind=kreal), allocatable ::unode(:)
626  character(len=12) :: cnum
627  character(len=16), allocatable :: clyr(:)
628  logical :: is_dynamic
629 
630  is_dynamic = present(fstrdynamic)
631 
632  tnstrain => fstrsolid%TNSTRAIN
633  testrain => fstrsolid%TESTRAIN
634 
635  ntot_lyr = fstrsolid%max_lyr
636  is_33shell = fstrsolid%is_33shell
637  is_33beam = fstrsolid%is_33beam
638 
639  mm = hecmesh%n_node
640  if( hecmesh%n_elem>hecmesh%n_node ) mm = hecmesh%n_elem
641 
642  if( is_dynamic ) then
643  idx = 1
644  if( fstrdynamic%idx_eqa==1 .and. istep>0 ) idx = 2
645  endif
646 
647  ndof = hecmesh%n_dof
648  if( ndof==2 ) mdof = 3
649  if( ndof==3 ) mdof = 6
650  if( ndof==4 ) mdof = 6
651  if( ndof==6 ) mdof = 6
652 
653  if(is_33shell == 1 .and. fstrsolid%output_ctrl(4)%outinfo%on(27) )then
654  coef33 = 1 + 2*ntot_lyr
655  else
656  coef33 = 1
657  endif
658 
659  call hecmw_nullify_result_data( fstrresult )
660  gcomp = 0
661  gitem = 0
662  ncomp = 0
663  nitem = 0
664  ecomp = 0
665  eitem = 0
666 
667  ! --- COUNT SUM OF ALL NITEM
668  ! --- TIME
669  gcomp = gcomp + 1
670  gitem = gitem + 1
671  ! --- DISPLACEMENT
672  if( fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
673  if(ndof == 4) then
674  ncomp = ncomp + 1
675  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
676  ncomp = ncomp + 1
677  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
678  else if(ndof == 6) then
679  ncomp = ncomp + 1
680  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
681  else
682  ncomp = ncomp + 1
683  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
684  endif
685  endif
686  ! --- VELOCITY
687  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
688  ncomp = ncomp + 1
689  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
690  endif
691  ! --- ACCELERATION
692  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
693  ncomp = ncomp + 1
694  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
695  endif
696  ! --- TEMPERATURE @node
697  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature) ) then
698  ncomp = ncomp + 1
699  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
700  endif
701  ! --- ROTATION (Only for 781 shell)
702  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
703  if(ndof == 6) then
704  ncomp = ncomp + 1
705  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), 3 )
706  else
707  if( is_33shell == 1 ) then
708  ncomp = ncomp + 1
709  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(18), ndof )
710  endif
711  endif
712  endif
713  ! --- REACTION FORCE
714  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
715  ncomp = ncomp + 1
716  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
717  endif
718  ! --- STRAIN @node
719  if( fstrsolid%output_ctrl(4)%outinfo%on(3) ) then
720  ncomp = ncomp + 1*coef33
721  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )*coef33
722  endif
723  ! --- STRESS @node
724  if( fstrsolid%output_ctrl(4)%outinfo%on(4) ) then
725  ncomp = ncomp + 1*coef33
726  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )*coef33
727  endif
728  ! --- MISES @node
729  if( fstrsolid%output_ctrl(4)%outinfo%on(5) ) then
730  ncomp = ncomp + 1*coef33
731  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )*coef33
732  endif
733  ! --- Principal Stress @node
734  if( fstrsolid%output_ctrl(4)%outinfo%on(19) ) then
735  ncomp = ncomp + 1*coef33
736  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )*coef33
737  endif
738  ! --- Principal Strain @node
739  if( fstrsolid%output_ctrl(4)%outinfo%on(21) ) then
740  ncomp = ncomp + 1*coef33
741  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )*coef33
742  endif
743  ! --- Principal Stress Vector @node
744  if( fstrsolid%output_ctrl(4)%outinfo%on(23) ) then
745  ncomp = ncomp + 3*coef33
746  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )*coef33
747  endif
748  ! --- Principal Strain Vector @node
749  if( fstrsolid%output_ctrl(4)%outinfo%on(25) ) then
750  ncomp = ncomp + 3*coef33
751  nitem = nitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )*coef33
752  endif
753  ! --- THERMAL STRAIN @node
754  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
755  ncomp = ncomp + 1
756  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
757  endif
758  ! --- CONTACT NORMAL FORCE @node
759  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
760  ncomp = ncomp + 1
761  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
762  endif
763  ! --- CONTACT FRICTION FORCE @node
764  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
765  ncomp = ncomp + 1
766  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
767  endif
768  ! --- CONTACT RELATIVE VELOCITY @node
769  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
770  ncomp = ncomp + 1
771  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
772  endif
773  ! --- CONTACT STATE @node
774  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
775  ncomp = ncomp + 1
776  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
777  endif
778  ! --- CONTACT NORMAL TRACTION @node
779  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
780  ncomp = ncomp + 1
781  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
782  endif
783  ! --- CONTACT FRICTION TRACTION @node
784  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
785  ncomp = ncomp + 1
786  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
787  endif
788  ! --- NODE ID @node
789  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
790  ncomp = ncomp + 1
791  nitem = nitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
792  endif
793  ! --- TEMPERATURE @node
794  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
795  ! ncomp = ncomp + 1
796  ! nitem = nitem + n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
797  !endif
798 
799  ! --- STRAIN @element
800  if( fstrsolid%output_ctrl(4)%outinfo%on(6) ) then
801  ecomp = ecomp + 1
802  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
803  endif
804  ! --- STRESS @element
805  if( fstrsolid%output_ctrl(4)%outinfo%on(7) ) then
806  ecomp = ecomp + 1
807  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
808  endif
809  ! --- MISES @element
810  if( fstrsolid%output_ctrl(4)%outinfo%on(8) ) then
811  ecomp = ecomp + 1
812  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
813  endif
814  ! --- Principal Stress @element
815  if( fstrsolid%output_ctrl(4)%outinfo%on(20) ) then
816  ecomp = ecomp + 1
817  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
818  endif
819  ! --- Principal Strain @element
820  if( fstrsolid%output_ctrl(4)%outinfo%on(22) ) then
821  ecomp = ecomp + 1
822  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
823  endif
824  ! --- Principal Stress Vector @element
825  if( fstrsolid%output_ctrl(4)%outinfo%on(24) ) then
826  ecomp = ecomp + 3
827  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
828  endif
829  ! --- Principal Strain Vector @element
830  if( fstrsolid%output_ctrl(4)%outinfo%on(26) ) then
831  ecomp = ecomp + 3
832  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
833  endif
834  ! --- PLASTIC STRAIN @element
835  if( fstrsolid%output_ctrl(4)%outinfo%on(43) ) then
836  ecomp = ecomp + 1
837  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
838  endif
839  ! --- MATERIAL @element
840  if( fstrsolid%output_ctrl(4)%outinfo%on(34) ) then
841  ecomp = ecomp + 1
842  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
843  endif
844  ! --- ORIENTATION @element
845  if( fstrsolid%output_ctrl(4)%outinfo%on(42) ) then
846  ecomp = ecomp + 3*coef33
847  eitem = eitem + 3*n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(42), ndof )*coef33
848  endif
849  ! --- ELEM ID @element
850  if( fstrsolid%output_ctrl(4)%outinfo%on(39) ) then
851  ecomp = ecomp + 1
852  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
853  endif
854  ! --- SECTION ID @element
855  if( fstrsolid%output_ctrl(4)%outinfo%on(40) ) then
856  ecomp = ecomp + 1
857  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
858  endif
859  ! --- ELEMACT flag @element
860  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
861  ecomp = ecomp + 1
862  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
863  endif
864 
865  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
866  fstrresult%ng_component = gcomp
867  fstrresult%nn_component = ncomp
868  fstrresult%ne_component = ecomp
869  allocate( fstrresult%ng_dof(gcomp) )
870  allocate( fstrresult%global_label(gcomp) )
871  allocate( fstrresult%global_val_item(gitem) )
872  allocate( fstrresult%nn_dof(ncomp) )
873  allocate( fstrresult%node_label(ncomp) )
874  allocate( fstrresult%node_val_item(nitem*hecmesh%n_node) )
875  allocate( fstrresult%ne_dof(ecomp) )
876  allocate( fstrresult%elem_label(ecomp) )
877  allocate( fstrresult%elem_val_item(eitem*hecmesh%n_elem) )
878  ncomp = 0
879  iitem = 0
880  ecomp = 0
881  jitem = 0
882 
883  ! --- TIME
884  fstrresult%ng_dof(1) = 1
885  fstrresult%global_label(1) = "TOTALTIME"
886  fstrresult%global_val_item(1) = time
887 
888  ! --- DISPLACEMENT
889  if (fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
890  if(ndof == 4) then
891  ! DIPLACEMENT
892  ncomp = ncomp + 1
893  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
894  fstrresult%nn_dof(ncomp) = nn
895  fstrresult%node_label(ncomp) = 'VELOCITY'
896  do i = 1, hecmesh%n_node
897  do j = 1, 3
898  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%DISP(4*(i-1)+j,idx)
899  enddo
900  enddo
901  iitem = iitem + nn
902  ! PRESSURE
903  ncomp = ncomp + 1
904  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
905  fstrresult%nn_dof(ncomp) = nn
906  fstrresult%node_label(ncomp) = 'PRESSURE'
907  do i = 1, hecmesh%n_node
908  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = fstrdynamic%DISP(4*i,idx)
909  enddo
910  iitem = iitem + nn
911  else if(ndof == 6) then
912  ncomp = ncomp + 1
913  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
914  fstrresult%nn_dof(ncomp) = nn
915  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
916  allocate( unode(3*hecmesh%n_node) )
917  unode = 0.0d0
918  if( is_dynamic ) then
919  do i=1, hecmesh%n_node
920  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
921  enddo
922  else
923  do i=1, hecmesh%n_node
924  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
925  enddo
926  endif
927  do i = 1, hecmesh%n_node
928  do j = 1, nn
929  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
930  enddo
931  enddo
932  deallocate( unode )
933  iitem = iitem + nn
934 
935  else
936  ncomp = ncomp + 1
937  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
938  fstrresult%nn_dof(ncomp) = nn
939  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
940  allocate( unode(ndof*hecmesh%n_node) )
941  unode = 0.0d0
942  if( is_dynamic ) then
943  unode(:) = fstrdynamic%DISP(:,idx)
944  else
945  unode(:) = fstrsolid%unode(:)
946  endif
947  if(is_33beam == 1)then
948  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
949  endif
950  if(is_33shell == 1)then
951  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
952  endif
953  do i = 1, hecmesh%n_node
954  do j = 1, nn
955  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
956  enddo
957  enddo
958  deallocate( unode )
959  iitem = iitem + nn
960  endif
961  endif
962 
963  ! --- VELOCITY
964  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
965  ncomp = ncomp + 1
966  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
967  fstrresult%nn_dof(ncomp) = nn
968  fstrresult%node_label(ncomp) = 'VELOCITY'
969  do i = 1, hecmesh%n_node
970  do j = 1, nn
971  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%VEL(nn*(i-1)+j,idx)
972  enddo
973  enddo
974  iitem = iitem + nn
975  endif
976 
977  ! --- ACCELERATION
978  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
979  ncomp = ncomp + 1
980  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
981  fstrresult%nn_dof(ncomp) = nn
982  fstrresult%node_label(ncomp) = 'ACCELERATION'
983  do i = 1, hecmesh%n_node
984  do j = 1, nn
985  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%ACC(nn*(i-1)+j,idx)
986  enddo
987  enddo
988  iitem = iitem + nn
989  endif
990 
991  ! --- TEMPERATURE
992  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature))then
993  ncomp = ncomp + 1
994  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
995  fstrresult%nn_dof(ncomp) = nn
996  fstrresult%node_label(ncomp) = 'TEMPERATURE'
997  do i = 1, hecmesh%n_node
998  do j = 1, nn
999  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%temperature(nn*(i-1)+j)
1000  enddo
1001  enddo
1002  iitem = iitem + nn
1003  endif
1004 
1005  ! --- ROTATION
1006  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
1007 
1008  if(ndof == 6) then
1009  ncomp = ncomp + 1
1010  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
1011  fstrresult%nn_dof(ncomp) = nn
1012  fstrresult%node_label(ncomp) = 'ROTATION'
1013  allocate( unode(3*hecmesh%n_node) )
1014  unode = 0.0d0
1015  if( is_dynamic ) then
1016  do i=1, hecmesh%n_node
1017  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
1018  enddo
1019  else
1020  do i=1, hecmesh%n_node
1021  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
1022  enddo
1023  endif
1024  do i = 1, hecmesh%n_node
1025  do j = 1, nn
1026  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1027  enddo
1028  enddo
1029  deallocate( unode )
1030  iitem = iitem + nn
1031  else
1032  if ( is_33shell == 1) then
1033  ncomp = ncomp + 1
1034  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
1035  fstrresult%nn_dof(ncomp) = nn
1036  fstrresult%node_label(ncomp) = 'ROTATION'
1037  allocate( unode(ndof*hecmesh%n_node) )
1038  unode = 0.0d0
1039  call fstr_reorder_rot_shell(fstrsolid, hecmesh, unode)
1040  do i = 1, hecmesh%n_node
1041  do j = 1, nn
1042  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1043  enddo
1044  enddo
1045  deallocate( unode )
1046  iitem = iitem + nn
1047  end if
1048  end if
1049  endif
1050 
1051  ! --- REACTION FORCE
1052  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
1053  ncomp = ncomp + 1
1054  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
1055  fstrresult%nn_dof(ncomp) = nn
1056  fstrresult%node_label(ncomp) = 'REACTION_FORCE'
1057  do i = 1, hecmesh%n_node
1058  do j = 1, nn
1059  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%REACTION(nn*(i-1)+j)
1060  enddo
1061  enddo
1062  iitem = iitem + nn
1063  endif
1064  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1065  if(is_33shell == 1 .or. ndof == 6)then
1066  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1067  & fstrsolid%SHELL, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1068  else
1069  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1070  & fstrsolid%SOLID, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1071  endif
1072 
1073  !laminated shell
1074  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(4)%outinfo%on(27) .and. is_33shell == 1 ) then
1075  allocate(clyr(2*ntot_lyr))
1076  do i=1,ntot_lyr
1077  write(cnum,"(i0)")i
1078  clyr(2*i-1)="_L"//trim(cnum)//"+"
1079  clyr(2*i )="_L"//trim(cnum)//"-"
1080  enddo
1081  do i=1,ntot_lyr
1082  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1083  & fstrsolid%SHELL%LAYER(i)%PLUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i-1) )
1084  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1085  & fstrsolid%SHELL%LAYER(i)%MINUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i ) )
1086  enddo
1087  deallocate(clyr)
1088  endif
1089 
1090  ! --- THERMAL STRAIN @node
1091  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
1092  ncomp = ncomp + 1
1093  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
1094  fstrresult%nn_dof(ncomp) = nn
1095  fstrresult%node_label(ncomp) = 'THERMAL_NodalSTRAIN'
1096  do i = 1, hecmesh%n_node
1097  do j = 1, nn
1098  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = tnstrain(nn*(i-1)+j)
1099  enddo
1100  enddo
1101  iitem = iitem + nn
1102  endif
1103 
1104  ! --- CONTACT NORMAL FORCE @node
1105  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1106  ncomp = ncomp + 1
1107  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
1108  fstrresult%nn_dof(ncomp) = nn
1109  fstrresult%node_label(ncomp) = 'CONTACT_NFORCE'
1110  do i = 1, hecmesh%n_node
1111  do j = 1, nn
1112  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NFORCE(nn*(i-1)+j)
1113  enddo
1114  enddo
1115  iitem = iitem + nn
1116  endif
1117 
1118  ! --- CONTACT FRICTION FORCE @node
1119  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1120  ncomp = ncomp + 1
1121  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
1122  fstrresult%nn_dof(ncomp) = nn
1123  fstrresult%node_label(ncomp) = 'CONTACT_FRICTION'
1124  do i = 1, hecmesh%n_node
1125  do j = 1, nn
1126  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FRIC(nn*(i-1)+j)
1127  enddo
1128  enddo
1129  iitem = iitem + nn
1130  endif
1131 
1132  ! --- CONTACT RELATIVE VELOCITY @node
1133  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1134  ncomp = ncomp + 1
1135  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
1136  fstrresult%nn_dof(ncomp) = nn
1137  fstrresult%node_label(ncomp) = 'CONTACT_RELVEL'
1138  do i = 1, hecmesh%n_node
1139  do j = 1, nn
1140  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_RELVEL(nn*(i-1)+j)
1141  enddo
1142  enddo
1143  iitem = iitem + nn
1144  endif
1145 
1146  ! --- CONTACT STATE @node
1147  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1148  ncomp = ncomp + 1
1149  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
1150  fstrresult%nn_dof(ncomp) = nn
1151  fstrresult%node_label(ncomp) = 'CONTACT_STATE'
1152  do i = 1, hecmesh%n_node
1153  do j = 1, nn
1154  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_STATE(nn*(i-1)+j)
1155  enddo
1156  enddo
1157  iitem = iitem + nn
1158  endif
1159 
1160  ! --- CONTACT NORMAL TRACTION @node
1161  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1162  ncomp = ncomp + 1
1163  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
1164  fstrresult%nn_dof(ncomp) = nn
1165  fstrresult%node_label(ncomp) = 'CONTACT_NTRACTION'
1166  do i = 1, hecmesh%n_node
1167  do j = 1, nn
1168  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NTRAC(nn*(i-1)+j)
1169  enddo
1170  enddo
1171  iitem = iitem + nn
1172  endif
1173 
1174  ! --- CONTACT FRICTION TRACTION @node
1175  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1176  ncomp = ncomp + 1
1177  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
1178  fstrresult%nn_dof(ncomp) = nn
1179  fstrresult%node_label(ncomp) = 'CONTACT_FTRACTION'
1180  do i = 1, hecmesh%n_node
1181  do j = 1, nn
1182  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FTRAC(nn*(i-1)+j)
1183  enddo
1184  enddo
1185  iitem = iitem + nn
1186  endif
1187 
1188  ! --- NODE ID @node
1189  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
1190  ncomp = ncomp + 1
1191  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
1192  fstrresult%nn_dof(ncomp) = nn
1193  fstrresult%node_label(ncomp) = 'NODE_ID'
1194  do i = 1, hecmesh%n_node
1195  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = hecmesh%global_node_ID(i)
1196  enddo
1197  iitem = iitem + nn
1198  endif
1199 
1200  ! --- TEMPERATURE @node
1201  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
1202  ! ncomp = ncomp + 1
1203  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
1204  ! fstrRESULT%nn_dof(ncomp) = nn
1205  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
1206  ! do i = 1, hecMESH%n_node
1207  ! fstrRESULT%node_val_item(nitem*(i-1)+1+iitem) = fstrSOLID%global_node_ID(i)
1208  ! enddo
1209  ! iitem = iitem + nn
1210  !endif
1211 
1212 
1213  ! --- MATERIAL @elem
1214  if(fstrsolid%output_ctrl(4)%outinfo%on(34)) then
1215  ecomp = ecomp + 1
1216  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
1217  fstrresult%ne_dof(ecomp) = nn
1218  fstrresult%elem_label(ecomp) = 'MATERIAL_ID'
1219  do i = 1, hecmesh%n_elem
1220  j = hecmesh%section_ID(i)
1221  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section%sect_mat_ID_item(j)
1222  enddo
1223  jitem = jitem + nn
1224  endif
1225 
1226  ! --- ELEM ID @elem
1227  if(fstrsolid%output_ctrl(4)%outinfo%on(39)) then
1228  ecomp = ecomp + 1
1229  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
1230  fstrresult%ne_dof(ecomp) = nn
1231  fstrresult%elem_label(ecomp) = 'ELEM_ID'
1232  do i = 1, hecmesh%n_elem
1233  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%global_elem_ID(i)
1234  enddo
1235  jitem = jitem + nn
1236  endif
1237 
1238  ! --- SECTION ID @elem
1239  if(fstrsolid%output_ctrl(4)%outinfo%on(40)) then
1240  ecomp = ecomp + 1
1241  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
1242  fstrresult%ne_dof(ecomp) = nn
1243  fstrresult%elem_label(ecomp) = 'SECTION_ID'
1244  do i = 1, hecmesh%n_elem
1245  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section_ID(i)
1246  enddo
1247  jitem = jitem + nn
1248  endif
1249 
1250  ! --- ELEMACT flag @element
1251  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
1252  ecomp = ecomp + 1
1253  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
1254  fstrresult%ne_dof(ecomp) = nn
1255  fstrresult%elem_label(ecomp) = 'ELEMACT'
1256  do i = 1, hecmesh%n_elem
1257  if( fstrsolid%elements(i)%elemact_flag /= kelact_inactive ) then
1258  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 1.d0
1259  else
1260  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 0.d0
1261  end if
1262  enddo
1263  jitem = jitem + nn
1264  endif
1265 
1266  end subroutine fstr_make_result
1267 
1268  subroutine fstr_make_result_main( hecMESH, fstrSOLID, fstrRESULT, RES, nitem, &
1269  & iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr )
1270  use m_fstr
1271  use m_out
1272  use m_static_lib
1273  use mmaterial
1274  use hecmw_util
1275 
1276  implicit none
1277  type (hecmwST_local_mesh) :: hecMESH
1278  type (fstr_solid) :: fstrSOLID
1279  type (hecmwST_result_data):: fstrRESULT
1280  type (fstr_solid_physic_val) :: RES
1281  integer(kind=kint) :: istep, flag
1282  integer(kind=kint) :: n_lyr, cid
1283 
1284  character(len=HECMW_HEADER_LEN) :: header
1285  character(len=HECMW_NAME_LEN) :: s, label, nameID, addfname
1286  character(len=16) :: clyr
1287  character(len=12) :: cnum
1288  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, eitem, nn, mm, ngauss, it
1289  integer(kind=kint) :: iitem, ncomp, jitem, ecomp, nlyr
1290  integer(kind=kint) :: isect, cdsys_ID, serr
1291  real(kind=kreal) :: coords(3,3), coordsys(3, 3)
1292  ndof = hecmesh%n_dof
1293 
1294  ! --- STRAIN @node
1295  if( fstrsolid%output_ctrl(4)%outinfo%on(3)) then
1296  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )
1297  ncomp = ncomp + 1
1298  fstrresult%nn_dof(ncomp) = nn
1299  fstrresult%node_label(ncomp) = 'NodalSTRAIN'//trim(clyr)
1300  do i = 1, hecmesh%n_node
1301  do j = 1, nn
1302  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRAIN(nn*(i-1)+j)
1303  enddo
1304  enddo
1305  iitem = iitem + nn
1306  endif
1307 
1308  ! --- STRESS @node
1309  if(fstrsolid%output_ctrl(4)%outinfo%on(4)) then
1310  ncomp = ncomp + 1
1311  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )
1312  fstrresult%nn_dof(ncomp) = nn
1313  fstrresult%node_label(ncomp) = 'NodalSTRESS'//trim(clyr)
1314  do i = 1, hecmesh%n_node
1315  do j = 1, nn
1316  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRESS((nn)*(i-1)+j)
1317  enddo
1318  enddo
1319  iitem = iitem + nn
1320  endif
1321 
1322  ! --- MISES @node
1323  if(fstrsolid%output_ctrl(4)%outinfo%on(5)) then
1324  ncomp = ncomp + 1
1325  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )
1326  fstrresult%nn_dof(ncomp) = nn
1327  fstrresult%node_label(ncomp) = 'NodalMISES'//trim(clyr)
1328  do i = 1, hecmesh%n_node
1329  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = res%MISES(i)
1330  enddo
1331  iitem = iitem + nn
1332  endif
1333 
1334  ! --- Princ STRESS @node
1335  if(fstrsolid%output_ctrl(4)%outinfo%on(19)) then
1336  ncomp = ncomp + 1
1337  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )
1338  fstrresult%nn_dof(ncomp) = nn
1339  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESS'//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%PSTRESS((nn)*(i-1)+j)
1343  enddo
1344  enddo
1345  iitem = iitem + nn
1346  endif
1347 
1348  ! --- Princ STRESS Vector @node
1349  if(fstrsolid%output_ctrl(4)%outinfo%on(23)) then
1350  do k=1,3
1351  write(cnum, '(i0)') k
1352  ncomp = ncomp + 1
1353  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )
1354  fstrresult%nn_dof(ncomp) = nn
1355  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESSVector'//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%PSTRESS_VECT((nn)*(i-1)+j,k)
1359  enddo
1360  enddo
1361  iitem = iitem + nn
1362  end do
1363  endif
1364 
1365  ! --- Princ STRAIN @node
1366  if( fstrsolid%output_ctrl(4)%outinfo%on(21)) then
1367  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )
1368  ncomp = ncomp + 1
1369  fstrresult%nn_dof(ncomp) = nn
1370  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAIN'//trim(clyr)
1371  do i = 1, hecmesh%n_node
1372  do j = 1, nn
1373  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN(nn*(i-1)+j)
1374  enddo
1375  enddo
1376  iitem = iitem + nn
1377  endif
1378 
1379  ! --- Princ STRAIN Vector @node
1380  if( fstrsolid%output_ctrl(4)%outinfo%on(25)) then
1381  do k=1,3
1382  write(cnum, '(i0)') k
1383  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )
1384  ncomp = ncomp + 1
1385  fstrresult%nn_dof(ncomp) = nn
1386  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
1387  do i = 1, hecmesh%n_node
1388  do j = 1, nn
1389  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN_VECT(nn*(i-1)+j,k)
1390  enddo
1391  enddo
1392  iitem = iitem + nn
1393  enddo
1394  endif
1395 
1396  ! --- STRAIN @elem
1397  if( fstrsolid%output_ctrl(4)%outinfo%on(6)) then
1398  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
1399  ecomp = ecomp + 1
1400  fstrresult%ne_dof(ecomp) = nn
1401  fstrresult%elem_label(ecomp) = 'ElementalSTRAIN'
1402  do i = 1, hecmesh%n_elem
1403  do j = 1, nn
1404  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRAIN(nn*(i-1)+j)
1405  enddo
1406  enddo
1407  jitem = jitem + nn
1408  endif
1409 
1410  ! --- STRESS @elem
1411  if(fstrsolid%output_ctrl(4)%outinfo%on(7)) then
1412  ecomp = ecomp + 1
1413  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
1414  fstrresult%ne_dof(ecomp) = nn
1415  fstrresult%elem_label(ecomp) = 'ElementalSTRESS'
1416  do i = 1, hecmesh%n_elem
1417  do j = 1, nn
1418  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRESS((nn)*(i-1)+j)
1419  enddo
1420  enddo
1421  jitem = jitem + nn
1422  endif
1423 
1424  ! --- MISES @elem
1425  if(fstrsolid%output_ctrl(4)%outinfo%on(8)) then
1426  ecomp = ecomp + 1
1427  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
1428  fstrresult%ne_dof(ecomp) = nn
1429  fstrresult%elem_label(ecomp) = 'ElementalMISES'
1430  do i = 1, hecmesh%n_elem
1431  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EMISES(i)
1432  enddo
1433  jitem = jitem + nn
1434  endif
1435 
1436  ! --- Principal_STRESS @element
1437  if(fstrsolid%output_ctrl(4)%outinfo%on(20)) then
1438  ecomp = ecomp + 1
1439  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
1440  fstrresult%ne_dof(ecomp) = nn
1441  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESS'
1442  do i = 1, hecmesh%n_elem
1443  do j = 1, nn
1444  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS((nn)*(i-1)+j)
1445  enddo
1446  enddo
1447  jitem = jitem + nn
1448  endif
1449 
1450  ! --- Principal_STRAIN @element
1451  if(fstrsolid%output_ctrl(4)%outinfo%on(22)) then
1452  ecomp = ecomp + 1
1453  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
1454  fstrresult%ne_dof(ecomp) = nn
1455  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAIN'
1456  do i = 1, hecmesh%n_elem
1457  do j = 1, nn
1458  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN((nn)*(i-1)+j)
1459  enddo
1460  enddo
1461  jitem = jitem + nn
1462  endif
1463 
1464  ! --- ELEM PRINC STRESS VECTOR
1465  if(fstrsolid%output_ctrl(4)%outinfo%on(24)) then
1466  do k = 1, 3
1467  write(cnum,'(i0)')k
1468  ecomp = ecomp + 1
1469  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
1470  fstrresult%ne_dof(ecomp) = nn
1471  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESSVector'//trim(cnum)
1472  do i = 1, hecmesh%n_elem
1473  do j = 1, nn
1474  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS_VECT((nn)*(i-1)+j,k)
1475  enddo
1476  enddo
1477  jitem = jitem + nn
1478  enddo
1479  endif
1480 
1481  ! --- ELEM PRINC STRAIN VECTOR
1482  if(fstrsolid%output_ctrl(4)%outinfo%on(26)) then
1483  do k = 1, 3
1484  write(cnum,'(i0)')k
1485  ecomp = ecomp + 1
1486  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
1487  fstrresult%ne_dof(ecomp) = nn
1488  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAINVector'//trim(cnum)
1489  do i = 1, hecmesh%n_elem
1490  do j = 1, nn
1491  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN_VECT((nn)*(i-1)+j,k)
1492  enddo
1493  enddo
1494  jitem = jitem + nn
1495  enddo
1496  endif
1497 
1498  ! --- PLSTRAIN @elem
1499  if(fstrsolid%output_ctrl(4)%outinfo%on(43)) then
1500  ecomp = ecomp + 1
1501  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
1502  fstrresult%ne_dof(ecomp) = nn
1503  fstrresult%elem_label(ecomp) = 'ElementalPLSTRAIN'
1504  do i = 1, hecmesh%n_elem
1505  res%EPLSTRAIN(i) = 0.d0
1506  do j = 1, size(fstrsolid%elements(i)%gausses)
1507  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) + fstrsolid%elements(i)%gausses(j)%plstrain
1508  enddo
1509  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) / size(fstrsolid%elements(i)%gausses)
1510  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EPLSTRAIN(i)
1511  enddo
1512  jitem = jitem + nn
1513  endif
1514 
1515  ! --- ORIENTATION @elem
1516  if(fstrsolid%output_ctrl(4)%outinfo%on(42)) then
1517  do i = 1, 3
1518  write(cnum,'(i0)')i
1519  ecomp = ecomp + 1
1520  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(42), ndof )
1521  fstrresult%ne_dof(ecomp) = nn
1522  fstrresult%elem_label(ecomp) = 'ORIENTATION'//trim(cnum)
1523  enddo
1524  do i = 1, hecmesh%n_elem
1525  isect = hecmesh%section_ID(i)
1526  cdsys_id = hecmesh%section%sect_orien_ID(isect)
1527  if(cdsys_id == -1) then
1528  coordsys(:,:) = 0.0d0
1529  else
1530  call get_coordsys(cdsys_id, hecmesh, fstrsolid, coords, i)
1531  call set_localcoordsys( coords, g_localcoordsys(cdsys_id), coordsys(:, :), serr )
1532  endif
1533  do j = 1, 3
1534  do k = 1, 3
1535  fstrresult%elem_val_item(eitem*(i-1)+jitem+nn*(j-1)+k) = coordsys(j,k)
1536  enddo
1537  enddo
1538  enddo
1539  jitem = jitem + 3*nn
1540  endif
1541 
1542  end subroutine fstr_make_result_main
1543 
1544  subroutine fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
1545  use m_fstr
1546  use m_out
1547  use m_static_lib
1548 
1549  implicit none
1550  type (fstr_solid) :: fstrsolid
1551  type (hecmwst_local_mesh) :: hecmesh
1552  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1553  integer(kind=kint) :: mm, n1, n2
1554  real(kind=kreal), allocatable :: unode(:)
1555 
1556  do itype = 1, hecmesh%n_elem_type
1557  is = hecmesh%elem_type_index(itype-1) + 1
1558  ie = hecmesh%elem_type_index(itype )
1559  ic_type = hecmesh%elem_type_item(itype)
1560  if(ic_type == 781)then
1561  do icel = is, ie
1562  js = hecmesh%elem_node_index(icel-1)
1563  do j = 1, 4
1564  n1 = hecmesh%elem_node_item(js+j )
1565  n2 = hecmesh%elem_node_item(js+j+4)
1566  unode(3*n2-2) = unode(3*n1-2)
1567  unode(3*n2-1) = unode(3*n1-1)
1568  unode(3*n2 ) = unode(3*n1 )
1569  enddo
1570  enddo
1571  elseif(ic_type == 761)then
1572  do icel = is, ie
1573  js = hecmesh%elem_node_index(icel-1)
1574  do j = 1, 3
1575  n1 = hecmesh%elem_node_item(js+j )
1576  n2 = hecmesh%elem_node_item(js+j+3)
1577  unode(3*n2-2) = unode(3*n1-2)
1578  unode(3*n2-1) = unode(3*n1-1)
1579  unode(3*n2 ) = unode(3*n1 )
1580  enddo
1581  enddo
1582  endif
1583  enddo
1584 
1585  end subroutine fstr_reorder_node_shell
1586 
1587  subroutine fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
1588  use m_fstr
1589  use m_out
1590  use m_static_lib
1591 
1592  implicit none
1593  type (fstr_solid) :: fstrsolid
1594  type (hecmwst_local_mesh) :: hecmesh
1595  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1596  integer(kind=kint) :: mm, n1, n2
1597  real(kind=kreal), allocatable :: unode(:)
1598 
1599  do itype = 1, hecmesh%n_elem_type
1600  is = hecmesh%elem_type_index(itype-1) + 1
1601  ie = hecmesh%elem_type_index(itype )
1602  ic_type = hecmesh%elem_type_item(itype)
1603  if(ic_type == 781)then
1604  do icel = is, ie
1605  js = hecmesh%elem_node_index(icel-1)
1606  do j = 1, 4
1607  n1 = hecmesh%elem_node_item(js+j)
1608  n2 = hecmesh%elem_node_item(js+j+4)
1609  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1610  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1611  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1612  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1613  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1614  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1615  enddo
1616  enddo
1617  elseif(ic_type == 761)then
1618  do icel = is, ie
1619  js = hecmesh%elem_node_index(icel-1)
1620  do j = 1, 3
1621  n1 = hecmesh%elem_node_item(js+j)
1622  n2 = hecmesh%elem_node_item(js+j+3)
1623 
1624  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1625  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1626  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1627  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1628  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1629  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1630  enddo
1631  enddo
1632  endif
1633  enddo
1634 
1635  end subroutine fstr_reorder_rot_shell
1636 
1637  subroutine fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
1638  use m_fstr
1639  use m_out
1640  use m_static_lib
1641 
1642  implicit none
1643  type (fstr_solid) :: fstrsolid
1644  type (hecmwst_local_mesh) :: hecmesh
1645  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1646  integer(kind=kint) :: mm, a, b
1647  real(kind=kreal), allocatable :: unode(:)
1648 
1649  do itype = 1, hecmesh%n_elem_type
1650  is = hecmesh%elem_type_index(itype-1) + 1
1651  ie = hecmesh%elem_type_index(itype )
1652  ic_type = hecmesh%elem_type_item(itype)
1653  if(ic_type == 641)then
1654  do icel = is, ie
1655  js = hecmesh%elem_node_index(icel-1)
1656  do j = 1, 2
1657  a = hecmesh%elem_node_item(js+j)
1658  b = hecmesh%elem_node_item(js+j+2)
1659  unode(3*b-2) = unode(3*a-2)
1660  unode(3*b-1) = unode(3*a-1)
1661  unode(3*b ) = unode(3*a )
1662  enddo
1663  enddo
1664  endif
1665  enddo
1666 
1667  end subroutine fstr_reorder_node_beam
1668 
1669  subroutine setup_contact_output_variables( hecMESH, fstrSOLID, phase, dtime )
1670  use m_fstr
1671  use hecmw_util
1672  use mcontact
1673  implicit none
1674  type(hecmwst_local_mesh), intent(in) :: hecmesh
1675  type (fstr_solid), intent(inout) :: fstrsolid
1676  integer(kind=kint), intent(in) :: phase
1677  real(kind=kreal), optional, intent(in) :: dtime
1678 
1679  integer(kind=kint), parameter :: nval = 10
1680  logical, save :: updated(nval) = .false.
1681  integer(kind=kint) :: ndof, i
1682  real(kind=kreal) :: area, dt_use
1683 
1684  ndof = hecmesh%n_dof
1685 
1686  if( phase == -1 ) then
1687  updated(1:nval) = .false.
1688  return
1689  else
1690  if( phase /= 3 .and. phase /= 4 ) return !irregular case
1691  end if
1692 
1693  ! Update contact state vectors if dtime is provided
1694  if( present(dtime) .and. dtime > 0.d0 ) then
1695  dt_use = dtime
1696  else
1697  dt_use = 1.d0 ! default value if dtime not available
1698  endif
1699  if( .not. updated(3) .and. .not. updated(4) ) then
1700  call fstr_update_contact_state_vectors( fstrsolid, dt_use )
1701  endif
1702 
1703  ! --- CONTACT NORMAL FORCE @node
1704  if( fstrsolid%output_ctrl(phase)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1705  if( paracontactflag .and. .not. updated(1)) then
1706  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1707  end if
1708  updated(1) = .true.
1709  endif
1710 
1711  ! --- CONTACT FRICTION FORCE @node
1712  if( fstrsolid%output_ctrl(phase)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1713  if( paracontactflag .and. .not. updated(2)) then
1714  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1715  end if
1716  updated(2) = .true.
1717  endif
1718 
1719  ! --- CONTACT RELATIVE VELOCITY @node
1720  if( fstrsolid%output_ctrl(phase)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1721  if( paracontactflag .and. .not. updated(3)) then
1722  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_RELVEL,1)
1723  end if
1724  updated(3) = .true.
1725  endif
1726 
1727  ! --- CONTACT STATE @node
1728  if( fstrsolid%output_ctrl(phase)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1729  if( paracontactflag .and. .not. updated(4)) then
1730  call fstr_setup_parancon_contactvalue(hecmesh,1,fstrsolid%CONT_STATE,2)
1731  end if
1732  updated(4) = .true.
1733  endif
1734 
1735  ! --- CONTACT AREA for CONTACT TRACTION
1736  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .or. fstrsolid%output_ctrl(phase)%outinfo%on(37) ) then
1737  if( .not. updated(5)) call calc_contact_area( hecmesh, fstrsolid, 0 )
1738  ! fstr_setup_parancon_contactvalue is not necessary because
1739  ! contact area is calculated from original surface group
1740  end if
1741 
1742  ! --- CONTACT NORMAL TRACTION @node
1743  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1744  if( paracontactflag .and. .not. updated(6)) then
1745  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1746  end if
1747  fstrsolid%CONT_NTRAC(:) = 0.d0
1748  do i=1,hecmesh%nn_internal
1749  area = fstrsolid%CONT_AREA(i)
1750  if( area < 1.d-16 ) cycle
1751  fstrsolid%CONT_NTRAC(3*i-2:3*i) = fstrsolid%CONT_NFORCE(3*i-2:3*i)/area
1752  end do
1753  updated(6) = .true.
1754  endif
1755 
1756  ! --- CONTACT FRICTION TRACTION @node
1757  if( fstrsolid%output_ctrl(phase)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1758  if( paracontactflag .and. .not. updated(7)) then
1759  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1760  end if
1761  fstrsolid%CONT_FTRAC(:) = 0.d0
1762  do i=1,hecmesh%nn_internal
1763  area = fstrsolid%CONT_AREA(i)
1764  if( area < 1.d-16 ) cycle
1765  fstrsolid%CONT_FTRAC(3*i-2:3*i) = fstrsolid%CONT_FRIC(3*i-2:3*i)/area
1766  end do
1767  updated(7) = .true.
1768  endif
1769 
1770  end subroutine
1771 
1772 end module m_make_result
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=4), parameter kreal
This module defines common data and basic structures for analysis.
Definition: m_fstr.F90:15
subroutine get_coordsys(cdsys_ID, hecMESH, fstrSOLID, coords, icel)
This subroutine fetch coords defined by local coordinate system.
Definition: m_fstr.F90:1116
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.F90:103
This module provide a function to prepare output of static analysis.
Definition: make_result.f90:6
subroutine, public fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
subroutine, public fstr_make_result(hecMESH, fstrSOLID, fstrRESULT, istep, time, fstrDYNAMIC)
MAKE RESULT for static and dynamic analysis (WITHOUT ELEMENTAL RESULTS) -----------------------------...
subroutine, public fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
subroutine, public setup_contact_output_variables(hecMESH, fstrSOLID, phase, dtime)
subroutine fstr_make_result_main(hecMESH, fstrSOLID, fstrRESULT, RES, nitem, iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr)
subroutine, public fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
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
subroutine fstr_write_result_main(hecMESH, fstrSOLID, RES, clyr)
This module manages step information.
Definition: m_out.f90:6
integer function n_comp_valtype(vtype, ndim)
Definition: m_out.f90:204
This modules just summarizes all modules used in static analysis.
Definition: static_LIB.f90:6
Top-level contact analysis module (System level)
subroutine, public fstr_update_contact_state_vectors(fstrSOLID, dt)
Update contact state output vectors for all contacts.
This module summarizes all information of material properties.
Definition: material.f90:6
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.F90:535
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.F90:157