FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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
15
16
17contains
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
1627end 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_beam(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_shell(fstrsolid, hecmesh, unode)
subroutine, public fstr_reorder_rot_shell(fstrsolid, hecmesh, unode)
subroutine, public setup_contact_output_variables(hecmesh, fstrsolid, phase)
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
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
Data for STATIC ANSLYSIS (fstrSOLID)
Definition: m_fstr.f90:193