1!------------------------------------------------------------------------------- 2! Copyright (c) 2019 FrontISTR Commons 3! This software is released under the MIT License, see LICENSE.txt 4!------------------------------------------------------------------------------- 5!> This module provide a function to prepare output of static analysis 6module m_make_result 7 private 8 9 public:: fstr_write_result 10 public:: fstr_make_result 11 public:: fstr_reorder_node_shell 12 public:: fstr_reorder_rot_shell 13 public:: fstr_reorder_node_beam 14 public:: setup_contact_output_variables 15 16 17contains 18 19 !C*** 20 !> OUTPUT result file for static and dynamic analysis 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 !< analysis control parameters 33 integer(kind=kint) :: istep, flag 34 type (fstr_dynamic), intent(in), optional :: fstrDYNAMIC 35 real(kind=kreal) :: time !< current 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*** 534 !> MAKE RESULT for static and dynamic analysis (WITHOUT ELEMENTAL RESULTS) -------------------------------------------------------------- 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 !< -1:clear,3:result,4:vis 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 1628