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