FrontISTR  5.8.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=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  ! --- 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=6) :: clyr
456  character(len=4) :: 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
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=4) :: cnum
627  character(len=6), 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  ! --- ELEM ID @element
845  if( fstrsolid%output_ctrl(4)%outinfo%on(39) ) then
846  ecomp = ecomp + 1
847  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
848  endif
849  ! --- SECTION ID @element
850  if( fstrsolid%output_ctrl(4)%outinfo%on(40) ) then
851  ecomp = ecomp + 1
852  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
853  endif
854  ! --- ELEMACT flag @element
855  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
856  ecomp = ecomp + 1
857  eitem = eitem + n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
858  endif
859 
860  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
861  fstrresult%ng_component = gcomp
862  fstrresult%nn_component = ncomp
863  fstrresult%ne_component = ecomp
864  allocate( fstrresult%ng_dof(gcomp) )
865  allocate( fstrresult%global_label(gcomp) )
866  allocate( fstrresult%global_val_item(gitem) )
867  allocate( fstrresult%nn_dof(ncomp) )
868  allocate( fstrresult%node_label(ncomp) )
869  allocate( fstrresult%node_val_item(nitem*hecmesh%n_node) )
870  allocate( fstrresult%ne_dof(ecomp) )
871  allocate( fstrresult%elem_label(ecomp) )
872  allocate( fstrresult%elem_val_item(eitem*hecmesh%n_elem) )
873  ncomp = 0
874  iitem = 0
875  ecomp = 0
876  jitem = 0
877 
878  ! --- TIME
879  fstrresult%ng_dof(1) = 1
880  fstrresult%global_label(1) = "TOTALTIME"
881  fstrresult%global_val_item(1) = time
882 
883  ! --- DISPLACEMENT
884  if (fstrsolid%output_ctrl(4)%outinfo%on(1) ) then
885  if(ndof == 4) then
886  ! DIPLACEMENT
887  ncomp = ncomp + 1
888  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
889  fstrresult%nn_dof(ncomp) = nn
890  fstrresult%node_label(ncomp) = 'VELOCITY'
891  do i = 1, hecmesh%n_node
892  do j = 1, 3
893  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%DISP(4*(i-1)+j,idx)
894  enddo
895  enddo
896  iitem = iitem + nn
897  ! PRESSURE
898  ncomp = ncomp + 1
899  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 1 )
900  fstrresult%nn_dof(ncomp) = nn
901  fstrresult%node_label(ncomp) = 'PRESSURE'
902  do i = 1, hecmesh%n_node
903  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = fstrdynamic%DISP(4*i,idx)
904  enddo
905  iitem = iitem + nn
906  else if(ndof == 6) then
907  ncomp = ncomp + 1
908  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
909  fstrresult%nn_dof(ncomp) = nn
910  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
911  allocate( unode(3*hecmesh%n_node) )
912  unode = 0.0d0
913  if( is_dynamic ) then
914  do i=1, hecmesh%n_node
915  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+1:(i-1)*ndof+3, idx)
916  enddo
917  else
918  do i=1, hecmesh%n_node
919  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+1:(i-1)*ndof+3)
920  enddo
921  endif
922  do i = 1, hecmesh%n_node
923  do j = 1, nn
924  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
925  enddo
926  enddo
927  deallocate( unode )
928  iitem = iitem + nn
929 
930  else
931  ncomp = ncomp + 1
932  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
933  fstrresult%nn_dof(ncomp) = nn
934  fstrresult%node_label(ncomp) = 'DISPLACEMENT'
935  allocate( unode(ndof*hecmesh%n_node) )
936  unode = 0.0d0
937  if( is_dynamic ) then
938  unode(:) = fstrdynamic%DISP(:,idx)
939  else
940  unode(:) = fstrsolid%unode(:)
941  endif
942  if(is_33beam == 1)then
943  call fstr_reorder_node_beam(fstrsolid, hecmesh, unode)
944  endif
945  if(is_33shell == 1)then
946  call fstr_reorder_node_shell(fstrsolid, hecmesh, unode)
947  endif
948  do i = 1, hecmesh%n_node
949  do j = 1, nn
950  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
951  enddo
952  enddo
953  deallocate( unode )
954  iitem = iitem + nn
955  endif
956  endif
957 
958  ! --- VELOCITY
959  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(15) ) then
960  ncomp = ncomp + 1
961  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(15), ndof )
962  fstrresult%nn_dof(ncomp) = nn
963  fstrresult%node_label(ncomp) = 'VELOCITY'
964  do i = 1, hecmesh%n_node
965  do j = 1, nn
966  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%VEL(nn*(i-1)+j,idx)
967  enddo
968  enddo
969  iitem = iitem + nn
970  endif
971 
972  ! --- ACCELERATION
973  if( is_dynamic .and. fstrsolid%output_ctrl(4)%outinfo%on(16) ) then
974  ncomp = ncomp + 1
975  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(16), ndof )
976  fstrresult%nn_dof(ncomp) = nn
977  fstrresult%node_label(ncomp) = 'ACCELERATION'
978  do i = 1, hecmesh%n_node
979  do j = 1, nn
980  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrdynamic%ACC(nn*(i-1)+j,idx)
981  enddo
982  enddo
983  iitem = iitem + nn
984  endif
985 
986  ! --- TEMPERATURE
987  if( fstrsolid%output_ctrl(4)%outinfo%on(17) .and. associated(fstrsolid%temperature))then
988  ncomp = ncomp + 1
989  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(17), ndof )
990  fstrresult%nn_dof(ncomp) = nn
991  fstrresult%node_label(ncomp) = 'TEMPERATURE'
992  do i = 1, hecmesh%n_node
993  do j = 1, nn
994  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%temperature(nn*(i-1)+j)
995  enddo
996  enddo
997  iitem = iitem + nn
998  endif
999 
1000  ! --- ROTATION
1001  if( fstrsolid%output_ctrl(4)%outinfo%on(18) ) then
1002 
1003  if(ndof == 6) then
1004  ncomp = ncomp + 1
1005  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), 3 )
1006  fstrresult%nn_dof(ncomp) = nn
1007  fstrresult%node_label(ncomp) = 'ROTATION'
1008  allocate( unode(3*hecmesh%n_node) )
1009  unode = 0.0d0
1010  if( is_dynamic ) then
1011  do i=1, hecmesh%n_node
1012  unode((i-1)*3+1:(i-1)*3+3) = fstrdynamic%DISP((i-1)*ndof+4:(i-1)*ndof+6, idx)
1013  enddo
1014  else
1015  do i=1, hecmesh%n_node
1016  unode((i-1)*3+1:(i-1)*3+3) = fstrsolid%unode((i-1)*ndof+4:(i-1)*ndof+6)
1017  enddo
1018  endif
1019  do i = 1, hecmesh%n_node
1020  do j = 1, nn
1021  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1022  enddo
1023  enddo
1024  deallocate( unode )
1025  iitem = iitem + nn
1026  else
1027  if ( is_33shell == 1) then
1028  ncomp = ncomp + 1
1029  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(1), ndof )
1030  fstrresult%nn_dof(ncomp) = nn
1031  fstrresult%node_label(ncomp) = 'ROTATION'
1032  allocate( unode(ndof*hecmesh%n_node) )
1033  unode = 0.0d0
1034  call fstr_reorder_rot_shell(fstrsolid, hecmesh, unode)
1035  do i = 1, hecmesh%n_node
1036  do j = 1, nn
1037  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = unode(nn*(i-1)+j)
1038  enddo
1039  enddo
1040  deallocate( unode )
1041  iitem = iitem + nn
1042  end if
1043  end if
1044  endif
1045 
1046  ! --- REACTION FORCE
1047  if( fstrsolid%output_ctrl(4)%outinfo%on(2) ) then
1048  ncomp = ncomp + 1
1049  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(2), ndof )
1050  fstrresult%nn_dof(ncomp) = nn
1051  fstrresult%node_label(ncomp) = 'REACTION_FORCE'
1052  do i = 1, hecmesh%n_node
1053  do j = 1, nn
1054  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%REACTION(nn*(i-1)+j)
1055  enddo
1056  enddo
1057  iitem = iitem + nn
1058  endif
1059  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1060  if(is_33shell == 1 .or. ndof == 6)then
1061  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1062  & fstrsolid%SHELL, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1063  else
1064  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1065  & fstrsolid%SOLID, nitem, iitem, ncomp, eitem, jitem, ecomp, 1, " " )
1066  endif
1067 
1068  !laminated shell
1069  if( associated(fstrsolid%SHELL) .and. fstrsolid%output_ctrl(4)%outinfo%on(27) .and. is_33shell == 1 ) then
1070  allocate(clyr(2*ntot_lyr))
1071  do i=1,ntot_lyr
1072  write(cnum,"(i0)")i
1073  clyr(2*i-1)="_L"//trim(cnum)//"+"
1074  clyr(2*i )="_L"//trim(cnum)//"-"
1075  enddo
1076  do i=1,ntot_lyr
1077  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1078  & fstrsolid%SHELL%LAYER(i)%PLUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i-1) )
1079  call fstr_make_result_main( hecmesh, fstrsolid, fstrresult, &
1080  & fstrsolid%SHELL%LAYER(i)%MINUS, nitem, iitem, ncomp, eitem, jitem, ecomp, i+1, clyr(2*i ) )
1081  enddo
1082  deallocate(clyr)
1083  endif
1084 
1085  ! --- THERMAL STRAIN @node
1086  if( fstrsolid%output_ctrl(4)%outinfo%on(12) .and. associated(tnstrain) ) then
1087  ncomp = ncomp + 1
1088  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(12), ndof )
1089  fstrresult%nn_dof(ncomp) = nn
1090  fstrresult%node_label(ncomp) = 'THERMAL_NodalSTRAIN'
1091  do i = 1, hecmesh%n_node
1092  do j = 1, nn
1093  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = tnstrain(nn*(i-1)+j)
1094  enddo
1095  enddo
1096  iitem = iitem + nn
1097  endif
1098 
1099  ! --- CONTACT NORMAL FORCE @node
1100  if( fstrsolid%output_ctrl(4)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1101  ncomp = ncomp + 1
1102  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(30), ndof )
1103  fstrresult%nn_dof(ncomp) = nn
1104  fstrresult%node_label(ncomp) = 'CONTACT_NFORCE'
1105  do i = 1, hecmesh%n_node
1106  do j = 1, nn
1107  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NFORCE(nn*(i-1)+j)
1108  enddo
1109  enddo
1110  iitem = iitem + nn
1111  endif
1112 
1113  ! --- CONTACT FRICTION FORCE @node
1114  if( fstrsolid%output_ctrl(4)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1115  ncomp = ncomp + 1
1116  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(31), ndof )
1117  fstrresult%nn_dof(ncomp) = nn
1118  fstrresult%node_label(ncomp) = 'CONTACT_FRICTION'
1119  do i = 1, hecmesh%n_node
1120  do j = 1, nn
1121  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FRIC(nn*(i-1)+j)
1122  enddo
1123  enddo
1124  iitem = iitem + nn
1125  endif
1126 
1127  ! --- CONTACT RELATIVE VELOCITY @node
1128  if( fstrsolid%output_ctrl(4)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1129  ncomp = ncomp + 1
1130  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(32), ndof )
1131  fstrresult%nn_dof(ncomp) = nn
1132  fstrresult%node_label(ncomp) = 'CONTACT_RELVEL'
1133  do i = 1, hecmesh%n_node
1134  do j = 1, nn
1135  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_RELVEL(nn*(i-1)+j)
1136  enddo
1137  enddo
1138  iitem = iitem + nn
1139  endif
1140 
1141  ! --- CONTACT STATE @node
1142  if( fstrsolid%output_ctrl(4)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1143  ncomp = ncomp + 1
1144  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(33), ndof )
1145  fstrresult%nn_dof(ncomp) = nn
1146  fstrresult%node_label(ncomp) = 'CONTACT_STATE'
1147  do i = 1, hecmesh%n_node
1148  do j = 1, nn
1149  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_STATE(nn*(i-1)+j)
1150  enddo
1151  enddo
1152  iitem = iitem + nn
1153  endif
1154 
1155  ! --- CONTACT NORMAL TRACTION @node
1156  if( fstrsolid%output_ctrl(4)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1157  ncomp = ncomp + 1
1158  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(36), ndof )
1159  fstrresult%nn_dof(ncomp) = nn
1160  fstrresult%node_label(ncomp) = 'CONTACT_NTRACTION'
1161  do i = 1, hecmesh%n_node
1162  do j = 1, nn
1163  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_NTRAC(nn*(i-1)+j)
1164  enddo
1165  enddo
1166  iitem = iitem + nn
1167  endif
1168 
1169  ! --- CONTACT FRICTION TRACTION @node
1170  if( fstrsolid%output_ctrl(4)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1171  ncomp = ncomp + 1
1172  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(37), ndof )
1173  fstrresult%nn_dof(ncomp) = nn
1174  fstrresult%node_label(ncomp) = 'CONTACT_FTRACTION'
1175  do i = 1, hecmesh%n_node
1176  do j = 1, nn
1177  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = fstrsolid%CONT_FTRAC(nn*(i-1)+j)
1178  enddo
1179  enddo
1180  iitem = iitem + nn
1181  endif
1182 
1183  ! --- NODE ID @node
1184  if( fstrsolid%output_ctrl(4)%outinfo%on(38) ) then
1185  ncomp = ncomp + 1
1186  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(38), ndof )
1187  fstrresult%nn_dof(ncomp) = nn
1188  fstrresult%node_label(ncomp) = 'NODE_ID'
1189  do i = 1, hecmesh%n_node
1190  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = hecmesh%global_node_ID(i)
1191  enddo
1192  iitem = iitem + nn
1193  endif
1194 
1195  ! --- TEMPERATURE @node
1196  !if( fstrSOLID%output_ctrl(4)%outinfo%on(41) .and. associated(fstrSOLID%CONT_FTRAC) ) then
1197  ! ncomp = ncomp + 1
1198  ! nn = n_comp_valtype( fstrSOLID%output_ctrl(4)%outinfo%vtype(41), ndof )
1199  ! fstrRESULT%nn_dof(ncomp) = nn
1200  ! fstrRESULT%node_label(ncomp) = 'TEMPERATURE'
1201  ! do i = 1, hecMESH%n_node
1202  ! fstrRESULT%node_val_item(nitem*(i-1)+1+iitem) = fstrSOLID%global_node_ID(i)
1203  ! enddo
1204  ! iitem = iitem + nn
1205  !endif
1206 
1207 
1208  ! --- MATERIAL @elem
1209  if(fstrsolid%output_ctrl(4)%outinfo%on(34)) then
1210  ecomp = ecomp + 1
1211  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(34), ndof )
1212  fstrresult%ne_dof(ecomp) = nn
1213  fstrresult%elem_label(ecomp) = 'MATERIAL_ID'
1214  do i = 1, hecmesh%n_elem
1215  j = hecmesh%section_ID(i)
1216  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section%sect_mat_ID_item(j)
1217  enddo
1218  jitem = jitem + nn
1219  endif
1220 
1221  ! --- ELEM ID @elem
1222  if(fstrsolid%output_ctrl(4)%outinfo%on(39)) then
1223  ecomp = ecomp + 1
1224  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(39), ndof )
1225  fstrresult%ne_dof(ecomp) = nn
1226  fstrresult%elem_label(ecomp) = 'ELEM_ID'
1227  do i = 1, hecmesh%n_elem
1228  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%global_elem_ID(i)
1229  enddo
1230  jitem = jitem + nn
1231  endif
1232 
1233  ! --- SECTION ID @elem
1234  if(fstrsolid%output_ctrl(4)%outinfo%on(40)) then
1235  ecomp = ecomp + 1
1236  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(40), ndof )
1237  fstrresult%ne_dof(ecomp) = nn
1238  fstrresult%elem_label(ecomp) = 'SECTION_ID'
1239  do i = 1, hecmesh%n_elem
1240  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = hecmesh%section_ID(i)
1241  enddo
1242  jitem = jitem + nn
1243  endif
1244 
1245  ! --- ELEMACT flag @element
1246  if( fstrsolid%output_ctrl(4)%outinfo%on(44) ) then
1247  ecomp = ecomp + 1
1248  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(44), ndof )
1249  fstrresult%ne_dof(ecomp) = nn
1250  fstrresult%elem_label(ecomp) = 'ELEMACT'
1251  do i = 1, hecmesh%n_elem
1252  if( fstrsolid%elements(i)%elemact_flag == kelact_inactive ) then
1253  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 1.d0
1254  else
1255  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = 0.d0
1256  end if
1257  enddo
1258  jitem = jitem + nn
1259  endif
1260 
1261  end subroutine fstr_make_result
1262 
1263  subroutine fstr_make_result_main( hecMESH, fstrSOLID, fstrRESULT, RES, nitem, &
1264  & iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr )
1265  use m_fstr
1266  use m_out
1267  use m_static_lib
1268  use mmaterial
1269  use hecmw_util
1270 
1271  implicit none
1272  type (hecmwST_local_mesh) :: hecMESH
1273  type (fstr_solid) :: fstrSOLID
1274  type (hecmwST_result_data):: fstrRESULT
1275  type (fstr_solid_physic_val) :: RES
1276  integer(kind=kint) :: istep, flag
1277  integer(kind=kint) :: n_lyr, cid
1278 
1279  character(len=HECMW_HEADER_LEN) :: header
1280  character(len=HECMW_NAME_LEN) :: s, label, nameID, addfname
1281  character(len=6) :: clyr
1282  character(len=4) :: cnum
1283  integer(kind=kint) :: i, j, k, ndof, mdof, id, nitem, eitem, nn, mm, ngauss, it
1284  integer(kind=kint) :: iitem, ncomp, jitem, ecomp, nlyr
1285 
1286  ndof = hecmesh%n_dof
1287 
1288  ! --- STRAIN @node
1289  if( fstrsolid%output_ctrl(4)%outinfo%on(3)) then
1290  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(3), ndof )
1291  ncomp = ncomp + 1
1292  fstrresult%nn_dof(ncomp) = nn
1293  fstrresult%node_label(ncomp) = 'NodalSTRAIN'//trim(clyr)
1294  do i = 1, hecmesh%n_node
1295  do j = 1, nn
1296  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRAIN(nn*(i-1)+j)
1297  enddo
1298  enddo
1299  iitem = iitem + nn
1300  endif
1301 
1302  ! --- STRESS @node
1303  if(fstrsolid%output_ctrl(4)%outinfo%on(4)) then
1304  ncomp = ncomp + 1
1305  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(4), ndof )
1306  fstrresult%nn_dof(ncomp) = nn
1307  fstrresult%node_label(ncomp) = 'NodalSTRESS'//trim(clyr)
1308  do i = 1, hecmesh%n_node
1309  do j = 1, nn
1310  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%STRESS((nn)*(i-1)+j)
1311  enddo
1312  enddo
1313  iitem = iitem + nn
1314  endif
1315 
1316  ! --- MISES @node
1317  if(fstrsolid%output_ctrl(4)%outinfo%on(5)) then
1318  ncomp = ncomp + 1
1319  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(5), ndof )
1320  fstrresult%nn_dof(ncomp) = nn
1321  fstrresult%node_label(ncomp) = 'NodalMISES'//trim(clyr)
1322  do i = 1, hecmesh%n_node
1323  fstrresult%node_val_item(nitem*(i-1)+1+iitem) = res%MISES(i)
1324  enddo
1325  iitem = iitem + nn
1326  endif
1327 
1328  ! --- Princ STRESS @node
1329  if(fstrsolid%output_ctrl(4)%outinfo%on(19)) then
1330  ncomp = ncomp + 1
1331  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(19), ndof )
1332  fstrresult%nn_dof(ncomp) = nn
1333  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESS'//trim(clyr)
1334  do i = 1, hecmesh%n_node
1335  do j = 1, nn
1336  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS((nn)*(i-1)+j)
1337  enddo
1338  enddo
1339  iitem = iitem + nn
1340  endif
1341 
1342  ! --- Princ STRESS Vector @node
1343  if(fstrsolid%output_ctrl(4)%outinfo%on(23)) then
1344  do k=1,3
1345  write(cnum, '(i0)') k
1346  ncomp = ncomp + 1
1347  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(23), ndof )
1348  fstrresult%nn_dof(ncomp) = nn
1349  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRESSVector'//trim(cnum)//trim(clyr)
1350  do i = 1, hecmesh%n_node
1351  do j = 1, nn
1352  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRESS_VECT((nn)*(i-1)+j,k)
1353  enddo
1354  enddo
1355  iitem = iitem + nn
1356  end do
1357  endif
1358 
1359  ! --- Princ STRAIN @node
1360  if( fstrsolid%output_ctrl(4)%outinfo%on(21)) then
1361  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(21), ndof )
1362  ncomp = ncomp + 1
1363  fstrresult%nn_dof(ncomp) = nn
1364  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAIN'//trim(clyr)
1365  do i = 1, hecmesh%n_node
1366  do j = 1, nn
1367  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN(nn*(i-1)+j)
1368  enddo
1369  enddo
1370  iitem = iitem + nn
1371  endif
1372 
1373  ! --- Princ STRAIN Vector @node
1374  if( fstrsolid%output_ctrl(4)%outinfo%on(25)) then
1375  do k=1,3
1376  write(cnum, '(i0)') k
1377  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(25), ndof )
1378  ncomp = ncomp + 1
1379  fstrresult%nn_dof(ncomp) = nn
1380  fstrresult%node_label(ncomp) = 'NodalPrincipalSTRAINVector'//trim(cnum)//trim(clyr)
1381  do i = 1, hecmesh%n_node
1382  do j = 1, nn
1383  fstrresult%node_val_item(nitem*(i-1)+j+iitem) = res%PSTRAIN_VECT(nn*(i-1)+j,k)
1384  enddo
1385  enddo
1386  iitem = iitem + nn
1387  enddo
1388  endif
1389 
1390  ! --- STRAIN @elem
1391  if( fstrsolid%output_ctrl(4)%outinfo%on(6)) then
1392  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(6), ndof )
1393  ecomp = ecomp + 1
1394  fstrresult%ne_dof(ecomp) = nn
1395  fstrresult%elem_label(ecomp) = 'ElementalSTRAIN'
1396  do i = 1, hecmesh%n_elem
1397  do j = 1, nn
1398  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRAIN(nn*(i-1)+j)
1399  enddo
1400  enddo
1401  jitem = jitem + nn
1402  endif
1403 
1404  ! --- STRESS @elem
1405  if(fstrsolid%output_ctrl(4)%outinfo%on(7)) then
1406  ecomp = ecomp + 1
1407  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(7), ndof )
1408  fstrresult%ne_dof(ecomp) = nn
1409  fstrresult%elem_label(ecomp) = 'ElementalSTRESS'
1410  do i = 1, hecmesh%n_elem
1411  do j = 1, nn
1412  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%ESTRESS((nn)*(i-1)+j)
1413  enddo
1414  enddo
1415  jitem = jitem + nn
1416  endif
1417 
1418  ! --- MISES @elem
1419  if(fstrsolid%output_ctrl(4)%outinfo%on(8)) then
1420  ecomp = ecomp + 1
1421  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(8), ndof )
1422  fstrresult%ne_dof(ecomp) = nn
1423  fstrresult%elem_label(ecomp) = 'ElementalMISES'
1424  do i = 1, hecmesh%n_elem
1425  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EMISES(i)
1426  enddo
1427  jitem = jitem + nn
1428  endif
1429 
1430  ! --- Principal_STRESS @element
1431  if(fstrsolid%output_ctrl(4)%outinfo%on(20)) then
1432  ecomp = ecomp + 1
1433  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(20), ndof )
1434  fstrresult%ne_dof(ecomp) = nn
1435  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESS'
1436  do i = 1, hecmesh%n_elem
1437  do j = 1, nn
1438  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS((nn)*(i-1)+j)
1439  enddo
1440  enddo
1441  jitem = jitem + nn
1442  endif
1443 
1444  ! --- Principal_STRAIN @element
1445  if(fstrsolid%output_ctrl(4)%outinfo%on(22)) then
1446  ecomp = ecomp + 1
1447  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(22), ndof )
1448  fstrresult%ne_dof(ecomp) = nn
1449  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAIN'
1450  do i = 1, hecmesh%n_elem
1451  do j = 1, nn
1452  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN((nn)*(i-1)+j)
1453  enddo
1454  enddo
1455  jitem = jitem + nn
1456  endif
1457 
1458  ! --- ELEM PRINC STRESS VECTOR
1459  if(fstrsolid%output_ctrl(4)%outinfo%on(24)) then
1460  do k = 1, 3
1461  write(cnum,'(i0)')k
1462  ecomp = ecomp + 1
1463  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(24), ndof )
1464  fstrresult%ne_dof(ecomp) = nn
1465  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRESSVector'//trim(cnum)
1466  do i = 1, hecmesh%n_elem
1467  do j = 1, nn
1468  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRESS_VECT((nn)*(i-1)+j,k)
1469  enddo
1470  enddo
1471  jitem = jitem + nn
1472  enddo
1473  endif
1474 
1475  ! --- ELEM PRINC STRAIN VECTOR
1476  if(fstrsolid%output_ctrl(4)%outinfo%on(26)) then
1477  do k = 1, 3
1478  write(cnum,'(i0)')k
1479  ecomp = ecomp + 1
1480  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(26), ndof )
1481  fstrresult%ne_dof(ecomp) = nn
1482  fstrresult%elem_label(ecomp) = 'ElementalPrincipalSTRAINVector'//trim(cnum)
1483  do i = 1, hecmesh%n_elem
1484  do j = 1, nn
1485  fstrresult%elem_val_item(eitem*(i-1)+j+jitem) = res%EPSTRAIN_VECT((nn)*(i-1)+j,k)
1486  enddo
1487  enddo
1488  jitem = jitem + nn
1489  enddo
1490  endif
1491 
1492  ! --- PLSTRAIN @elem
1493  if(fstrsolid%output_ctrl(4)%outinfo%on(43)) then
1494  ecomp = ecomp + 1
1495  nn = n_comp_valtype( fstrsolid%output_ctrl(4)%outinfo%vtype(43), ndof )
1496  fstrresult%ne_dof(ecomp) = nn
1497  fstrresult%elem_label(ecomp) = 'ElementalPLSTRAIN'
1498  do i = 1, hecmesh%n_elem
1499  res%EPLSTRAIN(i) = 0.d0
1500  do j = 1, size(fstrsolid%elements(i)%gausses)
1501  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) + fstrsolid%elements(i)%gausses(j)%plstrain
1502  enddo
1503  res%EPLSTRAIN(i) = res%EPLSTRAIN(i) / size(fstrsolid%elements(i)%gausses)
1504  fstrresult%elem_val_item(eitem*(i-1)+1+jitem) = res%EPLSTRAIN(i)
1505  enddo
1506  jitem = jitem + nn
1507  endif
1508 
1509  end subroutine fstr_make_result_main
1510 
1511  subroutine fstr_reorder_node_shell(fstrSOLID, hecMESH, unode)
1512  use m_fstr
1513  use m_out
1514  use m_static_lib
1515 
1516  implicit none
1517  type (fstr_solid) :: fstrsolid
1518  type (hecmwst_local_mesh) :: hecmesh
1519  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1520  integer(kind=kint) :: mm, n1, n2
1521  real(kind=kreal), allocatable :: unode(:)
1522 
1523  do itype = 1, hecmesh%n_elem_type
1524  is = hecmesh%elem_type_index(itype-1) + 1
1525  ie = hecmesh%elem_type_index(itype )
1526  ic_type = hecmesh%elem_type_item(itype)
1527  if(ic_type == 781)then
1528  do icel = is, ie
1529  js = hecmesh%elem_node_index(icel-1)
1530  do j = 1, 4
1531  n1 = hecmesh%elem_node_item(js+j )
1532  n2 = hecmesh%elem_node_item(js+j+4)
1533  unode(3*n2-2) = unode(3*n1-2)
1534  unode(3*n2-1) = unode(3*n1-1)
1535  unode(3*n2 ) = unode(3*n1 )
1536  enddo
1537  enddo
1538  elseif(ic_type == 761)then
1539  do icel = is, ie
1540  js = hecmesh%elem_node_index(icel-1)
1541  do j = 1, 3
1542  n1 = hecmesh%elem_node_item(js+j )
1543  n2 = hecmesh%elem_node_item(js+j+3)
1544  unode(3*n2-2) = unode(3*n1-2)
1545  unode(3*n2-1) = unode(3*n1-1)
1546  unode(3*n2 ) = unode(3*n1 )
1547  enddo
1548  enddo
1549  endif
1550  enddo
1551 
1552  end subroutine fstr_reorder_node_shell
1553 
1554  subroutine fstr_reorder_rot_shell(fstrSOLID, hecMESH, unode)
1555  use m_fstr
1556  use m_out
1557  use m_static_lib
1558 
1559  implicit none
1560  type (fstr_solid) :: fstrsolid
1561  type (hecmwst_local_mesh) :: hecmesh
1562  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1563  integer(kind=kint) :: mm, n1, n2
1564  real(kind=kreal), allocatable :: unode(:)
1565 
1566  do itype = 1, hecmesh%n_elem_type
1567  is = hecmesh%elem_type_index(itype-1) + 1
1568  ie = hecmesh%elem_type_index(itype )
1569  ic_type = hecmesh%elem_type_item(itype)
1570  if(ic_type == 781)then
1571  do icel = is, ie
1572  js = hecmesh%elem_node_index(icel-1)
1573  do j = 1, 4
1574  n1 = hecmesh%elem_node_item(js+j)
1575  n2 = hecmesh%elem_node_item(js+j+4)
1576  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1577  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1578  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1579  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1580  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1581  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1582  enddo
1583  enddo
1584  elseif(ic_type == 761)then
1585  do icel = is, ie
1586  js = hecmesh%elem_node_index(icel-1)
1587  do j = 1, 3
1588  n1 = hecmesh%elem_node_item(js+j)
1589  n2 = hecmesh%elem_node_item(js+j+3)
1590 
1591  unode(3*n1-2) = fstrsolid%unode(3*n2-2)
1592  unode(3*n1-1) = fstrsolid%unode(3*n2-1)
1593  unode(3*n1 ) = fstrsolid%unode(3*n2 )
1594  unode(3*n2-2) = fstrsolid%unode(3*n2-2)
1595  unode(3*n2-1) = fstrsolid%unode(3*n2-1)
1596  unode(3*n2 ) = fstrsolid%unode(3*n2 )
1597  enddo
1598  enddo
1599  endif
1600  enddo
1601 
1602  end subroutine fstr_reorder_rot_shell
1603 
1604  subroutine fstr_reorder_node_beam(fstrSOLID, hecMESH, unode)
1605  use m_fstr
1606  use m_out
1607  use m_static_lib
1608 
1609  implicit none
1610  type (fstr_solid) :: fstrsolid
1611  type (hecmwst_local_mesh) :: hecmesh
1612  integer(kind=kint) :: i, j, k, itype, is, ie, ic_type, js, icel
1613  integer(kind=kint) :: mm, a, b
1614  real(kind=kreal), allocatable :: unode(:)
1615 
1616  do itype = 1, hecmesh%n_elem_type
1617  is = hecmesh%elem_type_index(itype-1) + 1
1618  ie = hecmesh%elem_type_index(itype )
1619  ic_type = hecmesh%elem_type_item(itype)
1620  if(ic_type == 641)then
1621  do icel = is, ie
1622  js = hecmesh%elem_node_index(icel-1)
1623  do j = 1, 2
1624  a = hecmesh%elem_node_item(js+j)
1625  b = hecmesh%elem_node_item(js+j+2)
1626  unode(3*b-2) = unode(3*a-2)
1627  unode(3*b-1) = unode(3*a-1)
1628  unode(3*b ) = unode(3*a )
1629  enddo
1630  enddo
1631  endif
1632  enddo
1633 
1634  end subroutine fstr_reorder_node_beam
1635 
1636  subroutine setup_contact_output_variables( hecMESH, fstrSOLID, phase )
1637  use m_fstr
1638  use hecmw_util
1639  use mcontact
1640  implicit none
1641  type(hecmwst_local_mesh), intent(in) :: hecmesh
1642  type (fstr_solid), intent(inout) :: fstrsolid
1643  integer(kind=kint), intent(in) :: phase
1644 
1645  integer(kind=kint), parameter :: nval = 10
1646  logical, save :: updated(nval) = .false.
1647  integer(kind=kint) :: ndof, i
1648  real(kind=kreal) :: area
1649 
1650  ndof = hecmesh%n_dof
1651 
1652  if( phase == -1 ) then
1653  updated(1:nval) = .false.
1654  return
1655  else
1656  if( phase /= 3 .and. phase /= 4 ) return !irregular case
1657  end if
1658 
1659  ! --- CONTACT NORMAL FORCE @node
1660  if( fstrsolid%output_ctrl(phase)%outinfo%on(30) .and. associated(fstrsolid%CONT_NFORCE) ) then
1661  if( paracontactflag .and. .not. updated(1)) then
1662  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1663  end if
1664  updated(1) = .true.
1665  endif
1666 
1667  ! --- CONTACT FRICTION FORCE @node
1668  if( fstrsolid%output_ctrl(phase)%outinfo%on(31) .and. associated(fstrsolid%CONT_FRIC) ) then
1669  if( paracontactflag .and. .not. updated(2)) then
1670  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1671  end if
1672  updated(2) = .true.
1673  endif
1674 
1675  ! --- CONTACT RELATIVE VELOCITY @node
1676  if( fstrsolid%output_ctrl(phase)%outinfo%on(32) .and. associated(fstrsolid%CONT_RELVEL) ) then
1677  if( paracontactflag .and. .not. updated(3)) then
1678  call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_RELVEL,1)
1679  end if
1680  updated(3) = .true.
1681  endif
1682 
1683  ! --- CONTACT STATE @node
1684  if( fstrsolid%output_ctrl(phase)%outinfo%on(33) .and. associated(fstrsolid%CONT_STATE) ) then
1685  if( paracontactflag .and. .not. updated(4)) then
1686  call fstr_setup_parancon_contactvalue(hecmesh,1,fstrsolid%CONT_STATE,2)
1687  end if
1688  updated(4) = .true.
1689  endif
1690 
1691  ! --- CONTACT AREA for CONTACT TRACTION
1692  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .or. fstrsolid%output_ctrl(phase)%outinfo%on(37) ) then
1693  if( .not. updated(5)) call calc_contact_area( hecmesh, fstrsolid, 0 )
1694  ! fstr_setup_parancon_contactvalue is not necessary because
1695  ! contact area is calculated from original surface group
1696  end if
1697 
1698  ! --- CONTACT NORMAL TRACTION @node
1699  if( fstrsolid%output_ctrl(phase)%outinfo%on(36) .and. associated(fstrsolid%CONT_NTRAC) ) then
1700  if( paracontactflag .and. .not. updated(6)) then
1701  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_NFORCE,1)
1702  end if
1703  fstrsolid%CONT_NTRAC(:) = 0.d0
1704  do i=1,hecmesh%nn_internal
1705  area = fstrsolid%CONT_AREA(i)
1706  if( area < 1.d-16 ) cycle
1707  fstrsolid%CONT_NTRAC(3*i-2:3*i) = fstrsolid%CONT_NFORCE(3*i-2:3*i)/area
1708  end do
1709  updated(6) = .true.
1710  endif
1711 
1712  ! --- CONTACT FRICTION TRACTION @node
1713  if( fstrsolid%output_ctrl(phase)%outinfo%on(37) .and. associated(fstrsolid%CONT_FTRAC) ) then
1714  if( paracontactflag .and. .not. updated(7)) then
1715  if( .not. updated(1)) call fstr_setup_parancon_contactvalue(hecmesh,ndof,fstrsolid%CONT_FRIC,1)
1716  end if
1717  fstrsolid%CONT_FTRAC(:) = 0.d0
1718  do i=1,hecmesh%nn_internal
1719  area = fstrsolid%CONT_AREA(i)
1720  if( area < 1.d-16 ) cycle
1721  fstrsolid%CONT_FTRAC(3*i-2:3*i) = fstrsolid%CONT_FRIC(3*i-2:3*i)/area
1722  end do
1723  updated(7) = .true.
1724  endif
1725 
1726  end subroutine
1727 
1728 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
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.f90:101
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 fstr_make_result_main(hecMESH, fstrSOLID, fstrRESULT, RES, nitem, iitem, ncomp, eitem, jitem, ecomp, nlyr, clyr)
subroutine, public setup_contact_output_variables(hecMESH, fstrSOLID, phase)
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
This module provides functions to calculate contact stiff matrix.
Definition: fstr_contact.f90:6
subroutine fstr_setup_parancon_contactvalue(hecMESH, ndof, vec, vtype)
subroutine calc_contact_area(hecMESH, fstrSOLID, flag)
This module summarizes all information of material properties.
Definition: material.f90:6
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.f90:513
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.f90:155