FrontISTR  6.0.0
Large-scale structural analysis program with finit element method
fstr_solid_setup.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 !-------------------------------------------------------------------------------
11 module m_fstr_solid_setup
12  use m_fstr
13  use hecmw_setup_util, only &
14  : node_grp_name_to_id_ex &
15  , elem_grp_name_to_id_ex &
16  , surf_grp_name_to_id_ex &
17  , hecmw_streqr &
18  , hecmw_expand_integer_array &
19  , hecmw_expand_real_array
20  use fstr_setup_util, only &
21  : fstr_param_pack &
22  , fstr_card_slot &
23  , fstr_ctrl_err_stop &
24  , amp_name_to_id &
25  , dload_grp_name_to_id_ex &
26  , fstr_setup_util_err_stop
27  use fstr_ctrl_common
28  use fstr_ctrl_static
29  use fstr_ctrl_dynamic
30  use fstr_ctrl_material
31  use fstr_ctrl_util_f
32  implicit none
33 
34 contains
35 
37  subroutine fstr_solid_init( hecMESH, fstrSOLID )
38  use m_fstr
39  type(hecmwst_local_mesh),target :: hecMESH
40  type(fstr_solid) :: fstrSOLID
41 
42  fstrsolid%file_type = kbcffstr
43 
44  fstrsolid%BOUNDARY_ngrp_tot = 0
45  fstrsolid%BOUNDARY_ngrp_rot = 0
46  fstrsolid%CLOAD_ngrp_tot = 0
47  fstrsolid%CLOAD_ngrp_rot = 0
48  fstrsolid%DLOAD_ngrp_tot = 0
49  fstrsolid%DLOAD_follow = 1
50  fstrsolid%TEMP_ngrp_tot = 0
51  fstrsolid%SPRING_ngrp_tot = 0
52  fstrsolid%TEMP_irres = 0
53  fstrsolid%TEMP_tstep = 1
54  fstrsolid%TEMP_interval = 1
55  fstrsolid%TEMP_rtype = 1
56  fstrsolid%TEMP_factor = 1.d0
57  fstrsolid%VELOCITY_ngrp_tot = 0
58  fstrsolid%VELOCITY_ngrp_rot = 0
59  fstrsolid%ACCELERATION_ngrp_tot = 0
60  fstrsolid%COUPLE_ngrp_tot = 0
61 
62  fstrsolid%restart_nout= 0
63  fstrsolid%is_smoothing_active = .false.
64  fstrsolid%has_finite_rotation_kinematics = .false.
65  fstrsolid%finite_rotation_state_ready = .false.
66 
67  fstrsolid%elemopt361 = 0
68  fstrsolid%AutoINC_stat = 0
69  fstrsolid%CutBack_stat = 0
70  fstrsolid%NRstat_i(:) = 0
71  fstrsolid%NRstat_r(:) = 0.d0
72 
73  end subroutine fstr_solid_init
74 
76  subroutine fstr_solid_alloc( hecMESH, fstrSOLID )
77  use m_fstr
78  use m_fstr_finiterotationkinematics, only: fstr_has_finite_rotation_kinematics, &
79  fstr_mark_finite_rotation_nodes
80  type(hecmwst_local_mesh),target :: hecMESH
81  type(fstr_solid) :: fstrSOLID
82 
83  integer :: ndof, ntotal, ierror
84 
85  ndof=hecmesh%n_dof
86  ntotal=ndof*hecmesh%n_node
87  fstrsolid%has_finite_rotation_kinematics = &
88  fstr_has_finite_rotation_kinematics( hecmesh, fstrsolid )
89  fstrsolid%finite_rotation_state_ready = .false.
90 
91  allocate ( fstrsolid%GL( ntotal ) ,stat=ierror )
92  if( ierror /= 0 ) then
93  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, GL>'
94  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
95  call flush(idbg)
96  call hecmw_abort( hecmw_comm_get_comm())
97  end if
98  allocate ( fstrsolid%GL0( ntotal ) ,stat=ierror )
99  if( ierror /= 0 ) then
100  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, GL0>'
101  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
102  call flush(idbg)
103  call hecmw_abort( hecmw_comm_get_comm())
104  end if
105  allocate ( fstrsolid%EFORCE( ntotal ) ,stat=ierror )
106  if( ierror /= 0 ) then
107  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, EFORCE>'
108  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
109  call flush(idbg)
110  call hecmw_abort( hecmw_comm_get_comm())
111  end if
112  ! allocate ( fstrSOLID%TOTAL_DISP( ntotal ) ,STAT=ierror )
113  ! if( ierror /= 0 ) then
114  ! write(idbg,*) 'stop due to allocation error <FSTR_SOLID, TOTAL_DISP>'
115  ! write(idbg,*) ' rank = ', hecMESH%my_rank,' ierror = ',ierror
116  ! call flush(idbg)
117  ! call hecmw_abort( hecmw_comm_get_comm())
118  ! end if
119  allocate ( fstrsolid%unode( ntotal ) ,stat=ierror )
120  if( ierror /= 0 ) then
121  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, unode>'
122  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
123  call flush(idbg)
124  call hecmw_abort( hecmw_comm_get_comm())
125  end if
126  allocate ( fstrsolid%unode_bak( ntotal ) ,stat=ierror )
127  if( ierror /= 0 ) then
128  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, unode>'
129  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
130  call flush(idbg)
131  call hecmw_abort( hecmw_comm_get_comm())
132  end if
133  allocate ( fstrsolid%dunode( ntotal ) ,stat=ierror )
134  if( ierror /= 0 ) then
135  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, dunode>'
136  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
137  call flush(idbg)
138  call hecmw_abort( hecmw_comm_get_comm())
139  end if
140  allocate ( fstrsolid%ddunode( ntotal ) ,stat=ierror )
141  if( ierror /= 0 ) then
142  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, ddunode>'
143  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
144  call flush(idbg)
145  call hecmw_abort( hecmw_comm_get_comm())
146  end if
147  if( fstrsolid%has_finite_rotation_kinematics ) then
148  allocate ( fstrsolid%shell_node_mode( hecmesh%n_node ) ,stat=ierror )
149  if( ierror /= 0 ) then
150  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_node_mode>'
151  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
152  call flush(idbg)
153  call hecmw_abort( hecmw_comm_get_comm())
154  end if
155  call fstr_mark_finite_rotation_nodes( hecmesh, fstrsolid, ndof, fstrsolid%shell_node_mode )
156  allocate ( fstrsolid%shell_rot_state( hecmesh%n_node ) ,stat=ierror )
157  if( ierror /= 0 ) then
158  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_rot_state>'
159  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
160  call flush(idbg)
161  call hecmw_abort( hecmw_comm_get_comm())
162  end if
163  allocate ( fstrsolid%shell_ref_triad( 9*hecmesh%n_node ) ,stat=ierror )
164  if( ierror /= 0 ) then
165  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_ref_triad>'
166  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
167  call flush(idbg)
168  call hecmw_abort( hecmw_comm_get_comm())
169  end if
170  allocate ( fstrsolid%shell_triad( 9*hecmesh%n_node ) ,stat=ierror )
171  if( ierror /= 0 ) then
172  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_triad>'
173  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
174  call flush(idbg)
175  call hecmw_abort( hecmw_comm_get_comm())
176  end if
177  allocate ( fstrsolid%shell_triad_bak( 9*hecmesh%n_node ) ,stat=ierror )
178  if( ierror /= 0 ) then
179  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_triad_bak>'
180  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
181  call flush(idbg)
182  call hecmw_abort( hecmw_comm_get_comm())
183  end if
184  allocate ( fstrsolid%shell_dtriad( 9*hecmesh%n_node ) ,stat=ierror )
185  if( ierror /= 0 ) then
186  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_dtriad>'
187  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
188  call flush(idbg)
189  call hecmw_abort( hecmw_comm_get_comm())
190  end if
191  allocate ( fstrsolid%shell_drill( hecmesh%n_node ) ,stat=ierror )
192  if( ierror /= 0 ) then
193  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_drill>'
194  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
195  call flush(idbg)
196  call hecmw_abort( hecmw_comm_get_comm())
197  end if
198  allocate ( fstrsolid%shell_drill_bak( hecmesh%n_node ) ,stat=ierror )
199  if( ierror /= 0 ) then
200  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_drill_bak>'
201  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
202  call flush(idbg)
203  call hecmw_abort( hecmw_comm_get_comm())
204  end if
205  allocate ( fstrsolid%shell_ddrill( hecmesh%n_node ) ,stat=ierror )
206  if( ierror /= 0 ) then
207  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, shell_ddrill>'
208  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
209  call flush(idbg)
210  call hecmw_abort( hecmw_comm_get_comm())
211  end if
212  end if
213  allocate ( fstrsolid%QFORCE( ntotal ) ,stat=ierror )
214  if( ierror /= 0 ) then
215  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, QFORCE>'
216  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
217  call flush(idbg)
218  call hecmw_abort( hecmw_comm_get_comm())
219  end if
220  allocate ( fstrsolid%DFORCE( ntotal ) ,stat=ierror )
221  if( ierror /= 0 ) then
222  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, DFORCE>'
223  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
224  call flush(idbg)
225  call hecmw_abort( hecmw_comm_get_comm())
226  end if
227  allocate ( fstrsolid%QFORCE_bak( ntotal ) ,stat=ierror )
228  if( ierror /= 0 ) then
229  write(idbg,*) 'stop due to allocation error <FSTR_SOLID, QFORCE_bak>'
230  write(idbg,*) ' rank = ', hecmesh%my_rank,' ierror = ',ierror
231  call flush(idbg)
232  call hecmw_abort( hecmw_comm_get_comm())
233  end if
234 
235  fstrsolid%GL(:)=0.d0
236  fstrsolid%GL0(:)=0.d0
237  ! fstrSOLID%TOTAL_DISP(:)=0.d0
238  fstrsolid%unode(:) = 0.d0
239  fstrsolid%unode_bak(:) = 0.d0
240  fstrsolid%dunode(:) = 0.d0
241  fstrsolid%ddunode(:) = 0.d0
242  if( associated(fstrsolid%shell_rot_state) ) fstrsolid%shell_rot_state(:) = 0
243  if( associated(fstrsolid%shell_ref_triad) ) fstrsolid%shell_ref_triad(:) = 0.d0
244  if( associated(fstrsolid%shell_triad) ) fstrsolid%shell_triad(:) = 0.d0
245  if( associated(fstrsolid%shell_triad_bak) ) fstrsolid%shell_triad_bak(:) = 0.d0
246  if( associated(fstrsolid%shell_dtriad) ) fstrsolid%shell_dtriad(:) = 0.d0
247  if( associated(fstrsolid%shell_drill) ) fstrsolid%shell_drill(:) = 0.d0
248  if( associated(fstrsolid%shell_drill_bak) ) fstrsolid%shell_drill_bak(:) = 0.d0
249  if( associated(fstrsolid%shell_ddrill) ) fstrsolid%shell_ddrill(:) = 0.d0
250  fstrsolid%QFORCE(:) = 0.d0
251  fstrsolid%QFORCE_bak(:) = 0.d0
252  ! DFORCE is assembled only by implicit dynamic analysis, but the convergence
253  ! check reads it in every analysis type.
254  fstrsolid%DFORCE(:) = 0.d0
255  fstrsolid%FACTOR( 1:2 ) = 0.d0
256 
257  ! for MPC
258  fstrsolid%n_fix_mpc = hecmesh%mpc%n_mpc
259  if( fstrsolid%n_fix_mpc>0 ) then
260  allocate( fstrsolid%mpc_const( fstrsolid%n_fix_mpc ) )
261  fstrsolid%mpc_const(:) = hecmesh%mpc%mpc_const(:)
262  endif
263 
264  ! initialize for linear static problems
265  fstrsolid%FACTOR(2)=1.d0
266  fstrsolid%FACTOR(1)=0.d0
267  end subroutine fstr_solid_alloc
268 
269  subroutine fstr_smoothed_element_init( hecMESH, fstrSOLID )
270  type(hecmwst_local_mesh),target :: hecMESH
271  type(fstr_solid) :: fstrSOLID
272 
273  logical, allocatable :: is_selem_list(:)
274  integer :: i, isect
275 
276  do isect=1,hecmesh%section%n_sect
277  if( fstrsolid%sections(isect)%elemopt341 == kel341sesns ) fstrsolid%is_smoothing_active = .true.
278  end do
279  if( .not. fstrsolid%is_smoothing_active ) return
280 
281  allocate(is_selem_list(hecmesh%n_elem), stat=i)
282  if( i /= 0 ) then
283  write(*,*) 'Allocation error: is_selem_list'
284  return
285  endif
286  is_selem_list(:) = .false.
287 
288  do i=1,hecmesh%n_elem
289  isect= hecmesh%section_ID(i)
290  if( hecmesh%elem_type(i) /= fe_tet4n ) cycle
291  if( fstrsolid%sections(isect)%elemopt341 == kel341sesns ) is_selem_list(i) = .true.
292  enddo
293 
294  call hecmw_create_smoothing_element_connectivity(hecmesh,is_selem_list)
295 
296  deallocate(is_selem_list)
297 
298  end subroutine
299 
300  subroutine fstr_smoothed_element_calcmaxcon( hecMESH, fstrSOLID )
301  use m_static_lib_c3d4sesns
302  type(hecmwst_local_mesh),target :: hecMESH
303  type(fstr_solid) :: fstrSOLID
304 
305  integer :: i, nodlocal(fstrSOLID%max_ncon), iiS, nn, con_stf
306 
307  if( fstrsolid%max_ncon_stf > 20 ) fstrsolid%max_ncon_stf = 20
308 
309  do i=1,hecmesh%elem_type_index(hecmesh%n_elem_type)
310  if( hecmesh%elem_type(i) /= fe_nodesmooth_tet4n .and. hecmesh%elem_type(i) /= fe_edgesmooth_tet4n ) cycle
311  iis = hecmesh%elem_node_index(i-1)
312  nn = hecmesh%elem_node_index(i) - iis
313  nodlocal(1:nn) = hecmesh%elem_node_item(iis+1:iis+nn)
314  con_stf = return_nn_comp_c3d4_sesns(nn, nodlocal)
315  if( con_stf > fstrsolid%max_ncon_stf ) fstrsolid%max_ncon_stf = con_stf
316  enddo
317  end subroutine
318 
320  subroutine fstr_element_init( hecMESH, fstrSOLID, solution_type )
321  use elementinfo
322  use mmechgauss
323  use m_fstr_finiterotationkinematics, only: fstr_uses_finite_rotation_kinematics
324  use m_fstr
325  type(hecmwst_local_mesh),target :: hecMESH
326  type(fstr_solid) :: fstrSOLID
327  integer(kind=kint), intent(in) :: solution_type
328 
329  integer :: i, j, ng, isect, ndof, id, nn, n_elem, nthick
330 
331  if( hecmesh%n_elem <=0 ) then
332  stop "no element defined!"
333  endif
334 
335  fstrsolid%maxn_gauss = 0
336  fstrsolid%max_ncon = 0
337 
338  ! elemopt341 = kel341ES
339  call fstr_smoothed_element_init( hecmesh, fstrsolid )
340 
341  ! number of elements
342  n_elem = hecmesh%elem_type_index(hecmesh%n_elem_type)
343  allocate( fstrsolid%elements(n_elem) )
344 
345  do i=1,n_elem
346  fstrsolid%elements(i)%elemact_flag = kelact_undefined
347  if( solution_type == kstheat) cycle !fstrSOLID is used only for elemact element in heat transfer analysis
348 
349  fstrsolid%elements(i)%etype = hecmesh%elem_type(i)
350  if( hecmesh%elem_type(i)==301 ) fstrsolid%elements(i)%etype=111
351  if (hecmw_is_etype_link(fstrsolid%elements(i)%etype)) cycle
352  if (hecmw_is_etype_patch(fstrsolid%elements(i)%etype)) cycle
353  ng = numofquadpoints( fstrsolid%elements(i)%etype )
354  if( ng > fstrsolid%maxn_gauss ) fstrsolid%maxn_gauss = ng
355  if(ng>0) allocate( fstrsolid%elements(i)%gausses( ng ) )
356 
357  isect= hecmesh%section_ID(i)
358  ndof = getspacedimension( fstrsolid%elements(i)%etype )
359  if (ndof == 2) then ! why do this???
360  id=hecmesh%section%sect_opt(isect)
361  if( id==0 ) then
362  fstrsolid%elements(i)%iset=1
363  else if( id==1) then
364  fstrsolid%elements(i)%iset=0
365  else if( id==2) then
366  fstrsolid%elements(i)%iset=2
367  endif
368  endif
369 
370  if( isect<0 .or. isect>hecmesh%section%n_sect ) &
371  stop "Error in element's section definition"
372  id = hecmesh%section%sect_mat_ID_item(isect)
373  fstrsolid%materials(id)%cdsys_ID = hecmesh%section%sect_orien_ID(isect)
374  nn = hecmesh%elem_node_index(i)-hecmesh%elem_node_index(i-1)
375  do j=1,ng
376  fstrsolid%elements(i)%gausses(j)%pMaterial => fstrsolid%materials(id)
377  call fstr_init_gauss( fstrsolid%elements(i)%gausses( j ) )
378  enddo
379  nthick = 0
380  if( fstr_uses_finite_rotation_kinematics( fstrsolid%elements(i)%etype, nn, &
381  fstrsolid%materials(id) ) .or. &
382  fstr_uses_plane_stress_j2_shell(fstrsolid%elements(i)%etype, nn, &
383  fstrsolid%materials(id)) ) then
384  nthick = fstr_shell_num_thickness_points( fstrsolid%elements(i)%etype )
385  endif
386  if( nthick > 0 ) call fstr_init_shell_layer_gausses( fstrsolid%elements(i), ng, &
387  fstrsolid%materials(id)%totallyr, nthick )
388 
389  allocate(fstrsolid%elements(i)%equiForces(nn*ndof))
390  fstrsolid%elements(i)%equiForces = 0.0d0
391  if( nn > fstrsolid%max_ncon ) fstrsolid%max_ncon = nn
392 
393  if( hecmesh%elem_type(i)==361 ) then
394  if( fstrsolid%sections(isect)%elemopt361==kel361ic ) then
395  allocate( fstrsolid%elements(i)%aux(3,3) )
396  fstrsolid%elements(i)%aux = 0.0d0
397  endif
398  fstrsolid%elements(i)%p(1) = 0.0d0
399  endif
400 
401  enddo
402 
403  fstrsolid%max_ncon_stf = fstrsolid%max_ncon
404  if( fstrsolid%is_smoothing_active ) call fstr_smoothed_element_calcmaxcon( hecmesh, fstrsolid )
405 
406  call hecmw_allreduce_i1(hecmesh,fstrsolid%maxn_gauss,hecmw_max)
407  end subroutine
408 
409  recursive subroutine fstr_solid_physic_val_finalize( phys )
410  use m_fstr
411  implicit none
412  type(fstr_solid_physic_val) :: phys
413  integer :: i
414 
415  if(associated(phys%STRESS)) deallocate(phys%STRESS)
416  if(associated(phys%STRAIN)) deallocate(phys%STRAIN)
417  if(associated(phys%MISES)) deallocate(phys%MISES)
418 
419  if(associated(phys%PSTRESS)) deallocate(phys%PSTRESS)
420  if(associated(phys%PSTRAIN)) deallocate(phys%PSTRAIN)
421  if(associated(phys%PSTRESS_VECT)) deallocate(phys%PSTRESS_VECT)
422  if(associated(phys%PSTRAIN_VECT)) deallocate(phys%PSTRAIN_VECT)
423 
424  if(associated(phys%ESTRESS)) deallocate(phys%ESTRESS)
425  if(associated(phys%ESTRAIN)) deallocate(phys%ESTRAIN)
426  if(associated(phys%EMISES)) deallocate(phys%EMISES)
427  if(associated(phys%EPLSTRAIN)) deallocate(phys%EPLSTRAIN)
428 
429  if(associated(phys%EPSTRESS)) deallocate(phys%EPSTRESS)
430  if(associated(phys%EPSTRAIN)) deallocate(phys%EPSTRAIN)
431  if(associated(phys%EPSTRESS_VECT)) deallocate(phys%EPSTRESS_VECT)
432  if(associated(phys%EPSTRAIN_VECT)) deallocate(phys%EPSTRAIN_VECT)
433  if(associated(phys%ENQM)) deallocate(phys%ENQM)
434 
435  if(associated(phys%LAYER)) then
436  do i=1, size(phys%LAYER)
437  call fstr_solid_physic_val_finalize(phys%LAYER(i))
438  end do
439  deallocate(phys%LAYER)
440  end if
441  if(associated(phys%PLUS)) then
442  call fstr_solid_physic_val_finalize(phys%PLUS)
443  deallocate(phys%PLUS)
444  end if
445  if(associated(phys%MINUS)) then
446  call fstr_solid_physic_val_finalize(phys%MINUS)
447  deallocate(phys%MINUS)
448  end if
449  end subroutine
450 
452  subroutine fstr_solid_finalize( fstrSOLID )
453  use mmechgauss, only: fstr_finalize_shell_layer_gausses
454  implicit none
455  type(fstr_solid) :: fstrSOLID
456  integer :: i, j, ierror
457  if( associated(fstrsolid%materials) ) then
458  do j=1,size(fstrsolid%materials)
459  call finalizematerial(fstrsolid%materials(j))
460  enddo
461  deallocate( fstrsolid%materials )
462  endif
463  if( .not. associated(fstrsolid%elements ) ) return
464  do i=1,size(fstrsolid%elements)
465  if( associated(fstrsolid%elements(i)%gausses) ) then
466  do j=1,size(fstrsolid%elements(i)%gausses)
467  call fstr_finalize_gauss(fstrsolid%elements(i)%gausses(j))
468  enddo
469  deallocate( fstrsolid%elements(i)%gausses )
470  endif
471  call fstr_finalize_shell_layer_gausses( fstrsolid%elements(i) )
472  if(associated(fstrsolid%elements(i)%equiForces) ) then
473  deallocate(fstrsolid%elements(i)%equiForces)
474  endif
475  if( associated(fstrsolid%elements(i)%aux) ) then
476  deallocate(fstrsolid%elements(i)%aux)
477  endif
478  enddo
479 
480  deallocate( fstrsolid%elements )
481  if( associated( fstrsolid%mpc_const ) ) then
482  deallocate( fstrsolid%mpc_const )
483  endif
484  call free_stepinfo( fstrsolid%step_ctrl_restart )
485  if( associated(fstrsolid%step_ctrl) ) then
486  do i=1,size(fstrsolid%step_ctrl)
487  call free_stepinfo( fstrsolid%step_ctrl(i) )
488  enddo
489  deallocate( fstrsolid%step_ctrl )
490  endif
491  if(associated(fstrsolid%output_ctrl) ) then
492  do i=1,size(fstrsolid%output_ctrl)
493  if( fstrsolid%output_ctrl(i)%filenum==iutb ) &
494  close(fstrsolid%output_ctrl(i)%filenum)
495  enddo
496  deallocate(fstrsolid%output_ctrl)
497  endif
498  if( associated( fstrsolid%sections ) ) then
499  deallocate( fstrsolid%sections )
500  endif
501 
502  if( associated(fstrsolid%GL) ) then
503  deallocate(fstrsolid%GL ,stat=ierror)
504  if( ierror /= 0 ) then
505  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, GL>'
506  call flush(idbg)
507  call hecmw_abort( hecmw_comm_get_comm())
508  end if
509  endif
510  if( associated(fstrsolid%EFORCE) ) then
511  deallocate(fstrsolid%EFORCE ,stat=ierror)
512  if( ierror /= 0 ) then
513  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, EFORCE>'
514  call flush(idbg)
515  call hecmw_abort( hecmw_comm_get_comm())
516  end if
517  endif
518  if( associated(fstrsolid%unode) ) then
519  deallocate(fstrsolid%unode ,stat=ierror)
520  if( ierror /= 0 ) then
521  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, unode>'
522  call flush(idbg)
523  call hecmw_abort( hecmw_comm_get_comm())
524  end if
525  endif
526  if( associated(fstrsolid%unode_bak) ) then
527  deallocate(fstrsolid%unode_bak ,stat=ierror)
528  if( ierror /= 0 ) then
529  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, unode_bak>'
530  call flush(idbg)
531  call hecmw_abort( hecmw_comm_get_comm())
532  end if
533  endif
534  if( associated(fstrsolid%dunode) ) then
535  deallocate(fstrsolid%dunode ,stat=ierror)
536  if( ierror /= 0 ) then
537  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, dunode>'
538  call flush(idbg)
539  call hecmw_abort( hecmw_comm_get_comm())
540  end if
541  endif
542  if( associated(fstrsolid%ddunode) ) then
543  deallocate(fstrsolid%ddunode ,stat=ierror)
544  if( ierror /= 0 ) then
545  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, ddunode>'
546  call flush(idbg)
547  call hecmw_abort( hecmw_comm_get_comm())
548  end if
549  endif
550  if( associated(fstrsolid%shell_node_mode) ) then
551  deallocate(fstrsolid%shell_node_mode ,stat=ierror)
552  if( ierror /= 0 ) then
553  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_node_mode>'
554  call flush(idbg)
555  call hecmw_abort( hecmw_comm_get_comm())
556  end if
557  endif
558  if( associated(fstrsolid%shell_rot_state) ) then
559  deallocate(fstrsolid%shell_rot_state ,stat=ierror)
560  if( ierror /= 0 ) then
561  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_rot_state>'
562  call flush(idbg)
563  call hecmw_abort( hecmw_comm_get_comm())
564  end if
565  endif
566  if( associated(fstrsolid%shell_ref_triad) ) then
567  deallocate(fstrsolid%shell_ref_triad ,stat=ierror)
568  if( ierror /= 0 ) then
569  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_ref_triad>'
570  call flush(idbg)
571  call hecmw_abort( hecmw_comm_get_comm())
572  end if
573  endif
574  if( associated(fstrsolid%shell_triad) ) then
575  deallocate(fstrsolid%shell_triad ,stat=ierror)
576  if( ierror /= 0 ) then
577  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_triad>'
578  call flush(idbg)
579  call hecmw_abort( hecmw_comm_get_comm())
580  end if
581  endif
582  if( associated(fstrsolid%shell_triad_bak) ) then
583  deallocate(fstrsolid%shell_triad_bak ,stat=ierror)
584  if( ierror /= 0 ) then
585  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_triad_bak>'
586  call flush(idbg)
587  call hecmw_abort( hecmw_comm_get_comm())
588  end if
589  endif
590  if( associated(fstrsolid%shell_dtriad) ) then
591  deallocate(fstrsolid%shell_dtriad ,stat=ierror)
592  if( ierror /= 0 ) then
593  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_dtriad>'
594  call flush(idbg)
595  call hecmw_abort( hecmw_comm_get_comm())
596  end if
597  endif
598  if( associated(fstrsolid%shell_drill) ) then
599  deallocate(fstrsolid%shell_drill ,stat=ierror)
600  if( ierror /= 0 ) then
601  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_drill>'
602  call flush(idbg)
603  call hecmw_abort( hecmw_comm_get_comm())
604  end if
605  endif
606  if( associated(fstrsolid%shell_drill_bak) ) then
607  deallocate(fstrsolid%shell_drill_bak ,stat=ierror)
608  if( ierror /= 0 ) then
609  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_drill_bak>'
610  call flush(idbg)
611  call hecmw_abort( hecmw_comm_get_comm())
612  end if
613  endif
614  if( associated(fstrsolid%shell_ddrill) ) then
615  deallocate(fstrsolid%shell_ddrill ,stat=ierror)
616  if( ierror /= 0 ) then
617  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, shell_ddrill>'
618  call flush(idbg)
619  call hecmw_abort( hecmw_comm_get_comm())
620  end if
621  endif
622  if( associated(fstrsolid%QFORCE) ) then
623  deallocate(fstrsolid%QFORCE ,stat=ierror)
624  if( ierror /= 0 ) then
625  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, QFORCE>'
626  call flush(idbg)
627  call hecmw_abort( hecmw_comm_get_comm())
628  end if
629  endif
630  if( associated(fstrsolid%DFORCE) ) then
631  deallocate(fstrsolid%DFORCE ,stat=ierror)
632  if( ierror /= 0 ) then
633  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, DFORCE>'
634  call flush(idbg)
635  call hecmw_abort( hecmw_comm_get_comm())
636  end if
637  endif
638  if( associated(fstrsolid%temperature) ) then
639  deallocate(fstrsolid%temperature ,stat=ierror)
640  if( ierror /= 0 ) then
641  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, temperature>'
642  call flush(idbg)
643  call hecmw_abort( hecmw_comm_get_comm())
644  end if
645  endif
646  if( associated(fstrsolid%last_temp) ) then
647  deallocate(fstrsolid%last_temp ,stat=ierror)
648  if( ierror /= 0 ) then
649  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, reftemp>'
650  call flush(idbg)
651  call hecmw_abort( hecmw_comm_get_comm())
652  end if
653  endif
654  if( associated(fstrsolid%temp_bak) ) then
655  deallocate(fstrsolid%temp_bak ,stat=ierror)
656  if( ierror /= 0 ) then
657  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, reftemp>'
658  call flush(idbg)
659  call hecmw_abort( hecmw_comm_get_comm())
660  end if
661  endif
662 
663  ! Allocated in fstr_solid_append_boundary
664  if( associated(fstrsolid%BOUNDARY_ngrp_GRPID) ) then
665  deallocate(fstrsolid%BOUNDARY_ngrp_GRPID, stat=ierror)
666  if( ierror /= 0 ) then
667  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_GRPID>'
668  call flush(idbg)
669  call hecmw_abort( hecmw_comm_get_comm())
670  end if
671  endif
672  if( associated(fstrsolid%BOUNDARY_ngrp_ID) ) then
673  deallocate(fstrsolid%BOUNDARY_ngrp_ID, stat=ierror)
674  if( ierror /= 0 ) then
675  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_ID>'
676  call flush(idbg)
677  call hecmw_abort( hecmw_comm_get_comm())
678  end if
679  endif
680  if( associated(fstrsolid%BOUNDARY_ngrp_type) ) then
681  deallocate(fstrsolid%BOUNDARY_ngrp_type, stat=ierror)
682  if( ierror /= 0 ) then
683  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_type>'
684  call flush(idbg)
685  call hecmw_abort( hecmw_comm_get_comm())
686  end if
687  endif
688  if( associated(fstrsolid%BOUNDARY_ngrp_val) ) then
689  deallocate(fstrsolid%BOUNDARY_ngrp_val, stat=ierror)
690  if( ierror /= 0 ) then
691  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_val>'
692  call flush(idbg)
693  call hecmw_abort( hecmw_comm_get_comm())
694  end if
695  endif
696  if( associated(fstrsolid%BOUNDARY_ngrp_amp) ) then
697  deallocate(fstrsolid%BOUNDARY_ngrp_amp, stat=ierror)
698  if( ierror /= 0 ) then
699  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_amp>'
700  call flush(idbg)
701  call hecmw_abort( hecmw_comm_get_comm())
702  end if
703  endif
704  if( associated(fstrsolid%BOUNDARY_ngrp_istot) ) then
705  deallocate(fstrsolid%BOUNDARY_ngrp_istot, stat=ierror)
706  if( ierror /= 0 ) then
707  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_istot>'
708  call flush(idbg)
709  call hecmw_abort( hecmw_comm_get_comm())
710  end if
711  endif
712  if( associated(fstrsolid%BOUNDARY_ngrp_rotID) ) then
713  deallocate(fstrsolid%BOUNDARY_ngrp_rotID, stat=ierror)
714  if( ierror /= 0 ) then
715  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_rotID>'
716  call flush(idbg)
717  call hecmw_abort( hecmw_comm_get_comm())
718  end if
719  endif
720  if( associated(fstrsolid%BOUNDARY_ngrp_centerID) ) then
721  deallocate(fstrsolid%BOUNDARY_ngrp_centerID, stat=ierror)
722  if( ierror /= 0 ) then
723  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_centerID>'
724  call flush(idbg)
725  call hecmw_abort( hecmw_comm_get_comm())
726  end if
727  endif
728 
729  if(associated(fstrsolid%VELOCITY_ngrp_GRPID)) deallocate(fstrsolid%VELOCITY_ngrp_GRPID)
730  if(associated(fstrsolid%VELOCITY_ngrp_ID)) deallocate(fstrsolid%VELOCITY_ngrp_ID)
731  if(associated(fstrsolid%VELOCITY_ngrp_type)) deallocate(fstrsolid%VELOCITY_ngrp_type)
732  if(associated(fstrsolid%VELOCITY_ngrp_amp)) deallocate(fstrsolid%VELOCITY_ngrp_amp)
733  if(associated(fstrsolid%VELOCITY_ngrp_val)) deallocate(fstrsolid%VELOCITY_ngrp_val)
734  if(associated(fstrsolid%VELOCITY_ngrp_rotID)) deallocate(fstrsolid%VELOCITY_ngrp_rotID)
735  if(associated(fstrsolid%VELOCITY_ngrp_centerID)) deallocate(fstrsolid%VELOCITY_ngrp_centerID)
736 
737  if(associated(fstrsolid%ACCELERATION_ngrp_GRPID)) deallocate(fstrsolid%ACCELERATION_ngrp_GRPID)
738  if(associated(fstrsolid%ACCELERATION_ngrp_ID)) deallocate(fstrsolid%ACCELERATION_ngrp_ID)
739  if(associated(fstrsolid%ACCELERATION_ngrp_type)) deallocate(fstrsolid%ACCELERATION_ngrp_type)
740  if(associated(fstrsolid%ACCELERATION_ngrp_amp)) deallocate(fstrsolid%ACCELERATION_ngrp_amp)
741  if(associated(fstrsolid%ACCELERATION_ngrp_val)) deallocate(fstrsolid%ACCELERATION_ngrp_val)
742 
743  ! Allocated in fstr_solid_append_cload
744  if( associated(fstrsolid%CLOAD_ngrp_GRPID) ) then
745  deallocate(fstrsolid%CLOAD_ngrp_GRPID, stat=ierror)
746  if( ierror /= 0 ) then
747  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_GRPID>'
748  call flush(idbg)
749  call hecmw_abort( hecmw_comm_get_comm())
750  end if
751  endif
752  if( associated(fstrsolid%CLOAD_ngrp_ID) ) then
753  deallocate(fstrsolid%CLOAD_ngrp_ID, stat=ierror)
754  if( ierror /= 0 ) then
755  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_ID>'
756  call flush(idbg)
757  call hecmw_abort( hecmw_comm_get_comm())
758  end if
759  endif
760  if( associated(fstrsolid%CLOAD_ngrp_DOF) ) then
761  deallocate(fstrsolid%CLOAD_ngrp_DOF, stat=ierror)
762  if( ierror /= 0 ) then
763  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_DOF>'
764  call flush(idbg)
765  call hecmw_abort( hecmw_comm_get_comm())
766  end if
767  endif
768  if( associated(fstrsolid%CLOAD_ngrp_val) ) then
769  deallocate(fstrsolid%CLOAD_ngrp_val, stat=ierror)
770  if( ierror /= 0 ) then
771  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_val>'
772  call flush(idbg)
773  call hecmw_abort( hecmw_comm_get_comm())
774  end if
775  endif
776  if( associated(fstrsolid%CLOAD_ngrp_amp) ) then
777  deallocate(fstrsolid%CLOAD_ngrp_amp, stat=ierror)
778  if( ierror /= 0 ) then
779  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_amp>'
780  call flush(idbg)
781  call hecmw_abort( hecmw_comm_get_comm())
782  end if
783  endif
784  if( associated(fstrsolid%CLOAD_ngrp_rotID) ) then
785  deallocate(fstrsolid%CLOAD_ngrp_rotID, stat=ierror)
786  if( ierror /= 0 ) then
787  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_rotID>'
788  call flush(idbg)
789  call hecmw_abort( hecmw_comm_get_comm())
790  end if
791  endif
792  if( associated(fstrsolid%CLOAD_ngrp_centerID) ) then
793  deallocate(fstrsolid%CLOAD_ngrp_centerID, stat=ierror)
794  if( ierror /= 0 ) then
795  write(idbg,*) 'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_centerID>'
796  call flush(idbg)
797  call hecmw_abort( hecmw_comm_get_comm())
798  end if
799  endif
800 
801  if(associated(fstrsolid%DLOAD_ngrp_GRPID)) deallocate(fstrsolid%DLOAD_ngrp_GRPID)
802  if(associated(fstrsolid%DLOAD_ngrp_ID)) deallocate(fstrsolid%DLOAD_ngrp_ID)
803  if(associated(fstrsolid%DLOAD_ngrp_LID)) deallocate(fstrsolid%DLOAD_ngrp_LID)
804  if(associated(fstrsolid%DLOAD_ngrp_amp)) deallocate(fstrsolid%DLOAD_ngrp_amp)
805  if(associated(fstrsolid%DLOAD_ngrp_params)) deallocate(fstrsolid%DLOAD_ngrp_params)
806 
807  if(associated(fstrsolid%TEMP_ngrp_GRPID)) deallocate(fstrsolid%TEMP_ngrp_GRPID)
808  if(associated(fstrsolid%TEMP_ngrp_ID)) deallocate(fstrsolid%TEMP_ngrp_ID)
809  if(associated(fstrsolid%TEMP_ngrp_val)) deallocate(fstrsolid%TEMP_ngrp_val)
810 
811  if(associated(fstrsolid%SPRING_ngrp_GRPID)) deallocate(fstrsolid%SPRING_ngrp_GRPID)
812  if(associated(fstrsolid%SPRING_ngrp_ID)) deallocate(fstrsolid%SPRING_ngrp_ID)
813  if(associated(fstrsolid%SPRING_ngrp_DOF)) deallocate(fstrsolid%SPRING_ngrp_DOF)
814  if(associated(fstrsolid%SPRING_ngrp_amp)) deallocate(fstrsolid%SPRING_ngrp_amp)
815  if(associated(fstrsolid%SPRING_ngrp_val)) deallocate(fstrsolid%SPRING_ngrp_val)
816  if(associated(fstrsolid%SPRING_incremental)) deallocate(fstrsolid%SPRING_incremental)
817 
818  if(associated(fstrsolid%COUPLE_ngrp_ID)) deallocate(fstrsolid%COUPLE_ngrp_ID)
819 
820 ! if(associated(fstrSOLID%STRESS)) deallocate(fstrSOLID%STRESS)
821 ! if(associated(fstrSOLID%STRAIN)) deallocate(fstrSOLID%STRAIN)
822 ! if(associated(fstrSOLID%MISES)) deallocate(fstrSOLID%MISES)
823 ! if(associated(fstrSOLID%PSTRESS)) deallocate(fstrSOLID%PSTRESS)
824 ! if(associated(fstrSOLID%PSTRAIN)) deallocate(fstrSOLID%PSTRAIN)
825 ! if(associated(fstrSOLID%PSTRESS_VECT)) deallocate(fstrSOLID%PSTRESS_VECT)
826 ! if(associated(fstrSOLID%PSTRAIN_VECT)) deallocate(fstrSOLID%PSTRAIN_VECT)
827 
828 ! if(associated(fstrSOLID%ESTRESS)) deallocate(fstrSOLID%ESTRESS)
829 ! if(associated(fstrSOLID%ESTRAIN)) deallocate(fstrSOLID%ESTRAIN)
830 ! if(associated(fstrSOLID%EMISES)) deallocate(fstrSOLID%EMISES)
831 ! if(associated(fstrSOLID%EPLSTRAIN)) deallocate(fstrSOLID%EPLSTRAIN)
832 
833 ! if(associated(fstrSOLID%EPSTRESS)) deallocate(fstrSOLID%EPLSTRAIN)
834 ! if(associated(fstrSOLID%EPSTRAIN)) deallocate(fstrSOLID%EPLSTRAIN)
835 ! if(associated(fstrSOLID%EPSTRESS_VECT)) deallocate(fstrSOLID%EPLSTRAIN)
836 ! if(associated(fstrSOLID%EPSTRAIN_VECT)) deallocate(fstrSOLID%EPLSTRAIN)
837 
838  if(associated(fstrsolid%TNSTRAIN)) deallocate(fstrsolid%TNSTRAIN)
839  if(associated(fstrsolid%TESTRAIN)) deallocate(fstrsolid%TESTRAIN)
840 
841  if(associated(fstrsolid%YIELD_RATIO)) deallocate(fstrsolid%YIELD_RATIO)
842 
843 ! if(associated(fstrSOLID%ENQM)) deallocate(fstrSOLID%ENQM)
844  if(associated(fstrsolid%REACTION)) deallocate(fstrsolid%REACTION)
845 
846  if(associated(fstrsolid%CONT_NFORCE)) deallocate(fstrsolid%CONT_NFORCE)
847  if(associated(fstrsolid%CONT_FRIC)) deallocate(fstrsolid%CONT_FRIC)
848  if(associated(fstrsolid%CONT_RELVEL)) deallocate(fstrsolid%CONT_RELVEL)
849  if(associated(fstrsolid%CONT_STATE)) deallocate(fstrsolid%CONT_STATE)
850  if(associated(fstrsolid%CONT_SGRP_ID)) deallocate(fstrsolid%CONT_SGRP_ID)
851  if(associated(fstrsolid%CONT_AREA)) deallocate(fstrsolid%CONT_AREA)
852  if(associated(fstrsolid%CONT_NTRAC)) deallocate(fstrsolid%CONT_NTRAC)
853  if(associated(fstrsolid%CONT_FTRAC)) deallocate(fstrsolid%CONT_FTRAC)
854  if(associated(fstrsolid%EMBED_NFORCE)) deallocate(fstrsolid%EMBED_NFORCE)
855 
856  if(associated(fstrsolid%SOLID)) call fstr_solid_physic_val_finalize(fstrsolid%SOLID)
857  if(associated(fstrsolid%SHELL)) call fstr_solid_physic_val_finalize(fstrsolid%SHELL)
858  if(associated(fstrsolid%BEAM)) call fstr_solid_physic_val_finalize(fstrsolid%BEAM)
859 
860  if(associated(fstrsolid%is_rot)) deallocate(fstrsolid%is_rot)
861  if(associated(fstrsolid%GL0)) deallocate(fstrsolid%GL0)
862  if(associated(fstrsolid%QFORCE_bak)) deallocate(fstrsolid%QFORCE_bak)
863 
864  if(associated(fstrsolid%contacts)) then
865 ! do i=1, size(fstrSOLID%contacts)
866 ! call fstr_contact_finalize(fstrSOLID%contacts(i))
867 ! end do
868  deallocate(fstrsolid%contacts)
869  end if
870  if(associated(fstrsolid%embeds)) then
871 ! do i=1, size(fstrSOLID%embeds)
872 ! call fstr_contact_finalize(fstrSOLID%embeds(i))
873 ! end do
874  deallocate(fstrsolid%embeds)
875  end if
876  if(associated(fstrsolid%unode_bkup)) deallocate(fstrsolid%unode_bkup)
877  if(associated(fstrsolid%QFORCE_bkup)) deallocate(fstrsolid%QFORCE_bkup)
878  if(associated(fstrsolid%DFORCE_bkup)) deallocate(fstrsolid%DFORCE_bkup)
879  if(associated(fstrsolid%last_temp_bkup)) deallocate(fstrsolid%last_temp_bkup)
880  if(associated(fstrsolid%shell_triad_bkup)) deallocate(fstrsolid%shell_triad_bkup)
881  if(associated(fstrsolid%shell_drill_bkup)) deallocate(fstrsolid%shell_drill_bkup)
882  if(associated(fstrsolid%elements_bkup)) then
883  do i=1,size(fstrsolid%elements_bkup)
884  if( associated(fstrsolid%elements_bkup(i)%gausses) ) then
885  do j=1,size(fstrsolid%elements_bkup(i)%gausses)
886  call fstr_finalize_gauss(fstrsolid%elements_bkup(i)%gausses(j))
887  enddo
888  deallocate( fstrsolid%elements_bkup(i)%gausses )
889  endif
890  call fstr_finalize_shell_layer_gausses( fstrsolid%elements_bkup(i) )
891  if(associated(fstrsolid%elements_bkup(i)%equiForces) ) then
892  deallocate(fstrsolid%elements_bkup(i)%equiForces)
893  endif
894  if( associated(fstrsolid%elements_bkup(i)%aux) ) then
895  deallocate(fstrsolid%elements_bkup(i)%aux)
896  endif
897  enddo
898  deallocate(fstrsolid%elements_bkup)
899  end if
900  if(associated(fstrsolid%contacts_bkup)) then
901 ! do i=1, size(fstrSOLID%contacts_bkup)
902 ! call fstr_contact_finalize(fstrSOLID%contacts_bkup(i))
903 ! end do
904  deallocate(fstrsolid%contacts_bkup)
905  end if
906  if(associated(fstrsolid%embeds_bkup)) then
907 ! do i=1, size(fstrSOLID%embeds_bkup)
908 ! call fstr_contact_finalize(fstrSOLID%embeds_bkup(i))
909 ! end do
910  deallocate(fstrsolid%embeds_bkup)
911  end if
912 
913  end subroutine
914 
915  !-----------------------------------------------------------------------------!
917  !-----------------------------------------------------------------------------!
918 
919  subroutine fstr_setup_step( ctrl, P )
920  implicit none
921  integer(kind=kint) :: ctrl
922  type(fstr_param_pack) :: P
923  character(HECMW_NAME_LEN) :: amp
924  integer(kind=kint) :: amp_id
925 
926  integer(kind=kint) :: rcode, iproc
927 
928  amp = ' '
929  rcode = fstr_ctrl_get_step( ctrl, amp, iproc )
930  if( rcode /= 0 ) call fstr_ctrl_err_stop
931  call amp_name_to_id( p%MESH, '!STEP', amp, amp_id )
932  ! P%SOLID%NLSTATIC_ngrp_amp = amp_id;
933 
934  end subroutine fstr_setup_step
935 
937  subroutine fstr_setup_step_convergence( stepinfo, cpname, cnvparam, istep )
938  implicit none
939  type( step_info ), intent(inout) :: stepinfo
940  character(len=*), intent(in) :: cpname
941  type( tparamconverg ), intent(in) :: cnvparam(0:)
942  integer(kind=kint), intent(in) :: istep
943 
944  integer(kind=kint) :: i, id
945 
946  id = 0
947  if( len_trim(cpname) > 0 ) then
948  do i=1,ubound(cnvparam,1)
949  if( hecmw_streqr( cnvparam(i)%name, cpname ) ) then
950  id = i; exit
951  endif
952  enddo
953  if( id == 0 ) then
954  write(*,*) '### Error: CONVERG_PARAM referred to by STEP is not defined before it : ', trim(cpname)
955  write(ilog,*) '### Error: CONVERG_PARAM referred to by STEP is not defined before it : ', trim(cpname)
956  stop hecmw_exit_input
957  endif
958  endif
959 
960  call setup_stepinfo_converg( stepinfo, cnvparam(id) )
961 
962  if( .not. any( stepinfo%cnv_check(kcnvresidual:kcnvcorrection, kcnvtranslation:kcnvrotation, :) ) ) then
963  write(*,*) '### Error: RESIDUAL and CORRECTION are all SKIP in step : ', istep
964  write(ilog,*) '### Error: RESIDUAL and CORRECTION are all SKIP in step : ', istep
965  stop hecmw_exit_input
966  endif
967 
968  end subroutine fstr_setup_step_convergence
969 
972  subroutine fstr_setup_step_links( fstrPARAM, fstrSOLID, fstrDYNAMIC, istep, tp_name, ainc_name, cnv_name )
973  implicit none
974  type(fstr_param) :: fstrPARAM
975  type(fstr_solid) :: fstrSOLID
976  type(fstr_dynamic) :: fstrDYNAMIC
977  integer(kind=kint), intent(in) :: istep
978  character(len=*), intent(in) :: tp_name
979  character(len=*), intent(in) :: ainc_name
980  character(len=*), intent(in) :: cnv_name
981 
982  integer(kind=kint) :: i
983 
984  call fstr_setup_step_convergence( fstrsolid%step_ctrl(istep), cnv_name, fstrparam%cnvparam, istep )
985  ! For DYNAMIC fixed-increment: keep the !DYNAMIC time increment while preserving !STEP duration.
986  ! fstr_ctrl_get_ISTEP unconditionally sets initdt=1/num_substep which is wrong for DYNAMIC.
987  ! Only override initdt/mindt/maxdt; keep elapsetime and num_substep as-is.
988  if( fstrparam%solution_type==kstdynamic .and. &
989  & fstrsolid%step_ctrl(istep)%inc_type == stepfixedinc ) then
990  fstrsolid%step_ctrl(istep)%initdt = fstrdynamic%t_delta
991  fstrsolid%step_ctrl(istep)%mindt = fstrdynamic%t_delta
992  fstrsolid%step_ctrl(istep)%maxdt = fstrdynamic%t_delta
993  endif
994  if( associated(fstrparam%timepoints) ) then
995  do i=1,size(fstrparam%timepoints)
996  if( hecmw_streqr( fstrparam%timepoints(i)%name, tp_name ) ) then
997  fstrsolid%step_ctrl(istep)%timepoint_id = i; exit
998  endif
999  enddo
1000  endif
1001  if( associated(fstrparam%ainc) ) then
1002  do i=1,size(fstrparam%ainc)-1
1003  if( hecmw_streqr( fstrparam%ainc(i)%name, ainc_name ) ) then
1004  fstrsolid%step_ctrl(istep)%AincParam_id = i; exit
1005  endif
1006  enddo
1007  endif
1008  end subroutine fstr_setup_step_links
1009 
1011  subroutine fstr_setup_write_flags( ctrl, P )
1012  implicit none
1013  integer(kind=kint) :: ctrl
1014  type(fstr_param_pack) :: P
1015 
1016  type(t_output_ctrl) :: outctrl
1017  integer(kind=kint) :: islog, result, visual, femap
1018 
1019  call fstr_ctrl_get_output( ctrl, outctrl, islog, result, visual, femap )
1020  if( visual==1 ) p%PARAM%fg_visual= 1
1021  if( result==1 ) p%PARAM%fg_result = 1
1022  end subroutine fstr_setup_write_flags
1023 
1026  subroutine fstr_setup_write_store( ctrl, P )
1027  implicit none
1028  integer(kind=kint) :: ctrl
1029  type(fstr_param_pack) :: P
1030 
1031  type(fstr_solid), pointer :: fstrSOLID
1032  type(t_output_ctrl) :: outctrl
1033  integer(kind=kint) :: islog, result, visual, femap, c_output, ierror
1034  character(len=HECMW_FILENAME_LEN) :: logfileNAME
1035 
1036  fstrsolid => p%SOLID
1037  write( logfilename, '(i5,''.log'')' ) myrank
1038 
1039  call fstr_ctrl_get_output( ctrl, outctrl, islog, result, visual, femap )
1040  if( islog == 1 ) then
1041  c_output=1
1042  outctrl%filename = trim(logfilename)
1043  outctrl%filenum = ilog
1044  call fstr_copy_outctrl(fstrsolid%output_ctrl(c_output), outctrl)
1045  endif
1046  if( femap == 1 ) then
1047  c_output=2
1048  write( outctrl%filename, '(a,i0,a)') 'utable.',myrank,'.dat'
1049  outctrl%filenum = iutb
1050  call fstr_copy_outctrl(fstrsolid%output_ctrl(c_output), outctrl)
1051  open( unit=outctrl%filenum, file=outctrl%filename, status='REPLACE', iostat=ierror )
1052  if( ierror /= 0 ) then
1053  write(*,*) 'Warning: cannot open output file: ', trim(outctrl%filename)
1054  endif
1055  fstrsolid%output_ctrl(c_output)%outinfo%grp_id = 1
1056  endif
1057  if( result == 1 ) then
1058  c_output=3
1059  call fstr_copy_outctrl(fstrsolid%output_ctrl(c_output), outctrl)
1060  endif
1061  if( visual == 1 ) then
1062  c_output=4
1063  call fstr_copy_outctrl(fstrsolid%output_ctrl(c_output), outctrl)
1064  endif
1065  end subroutine fstr_setup_write_store
1066 
1067  !-----------------------------------------------------------------------------!
1069  !-----------------------------------------------------------------------------!
1070 
1071  subroutine fstr_setup_couple( ctrl, P )
1072  implicit none
1073  integer(kind=kint) :: ctrl
1074  type(fstr_param_pack) :: P
1075  integer(kind=kint) :: rcode
1076  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1077  integer(kind=kint) :: n
1078 
1079  if( p%SOLID%file_type /= kbcffstr ) return
1080 
1081  n = fstr_ctrl_get_data_line_n( ctrl )
1082  if( n == 0 ) return
1083 
1084  allocate( grp_id_name(n))
1085  rcode = fstr_ctrl_get_couple( ctrl, &
1086  p%PARAM%fg_couple_type, &
1087  p%PARAM%fg_couple_first, &
1088  p%PARAM%fg_couple_window, &
1089  grp_id_name, hecmw_name_len )
1090  if( rcode /= 0 ) call fstr_ctrl_err_stop
1091 
1092  call fstr_solid_append_couple( p%MESH, p%SOLID, p%PARAM, '!COUPLE', n, grp_id_name )
1093 
1094  deallocate( grp_id_name )
1095 
1096  end subroutine fstr_setup_couple
1097 
1099  subroutine fstr_setup_element_activation( ctrl, P )
1100  implicit none
1101  integer(kind=kint) :: ctrl
1102  type(fstr_param_pack) :: P
1103 
1104  integer(kind=kint) :: rcode
1105  character(HECMW_NAME_LEN) :: amp
1106  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1107  integer(kind=kint) :: n
1108  integer(kind=kint) :: gid, mode, measure, state
1109  real(kind=kreal) :: eps
1110  real(kind=kreal), pointer :: thlow(:), thup(:)
1111 
1112  gid = 1
1113  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1114 
1115  n = fstr_ctrl_get_data_line_n( ctrl )
1116  if( n == 0 ) return
1117 
1118  allocate( grp_id_name(n), thlow(n), thup(n) )
1119  amp = ' '
1120  eps = 1.d-3
1121  rcode = fstr_ctrl_get_element_activation( ctrl, amp, eps, grp_id_name, mode, measure, state, thlow, thup )
1122  if( rcode /= 0 ) call fstr_ctrl_err_stop
1123 
1124  call fstr_solid_append_element_activation( p%MESH, p%SOLID, '!ELEMENT_ACTIVATION', gid, &
1125  amp, eps, measure, state, n, grp_id_name, thlow, thup )
1126 
1127  deallocate( grp_id_name )
1128  end subroutine fstr_setup_element_activation
1129 
1130  !-----------------------------------------------------------------------------!
1132  !-----------------------------------------------------------------------------!
1133 
1134  subroutine fstr_setup_static( ctrl, P )
1135  implicit none
1136  integer(kind=kint) :: ctrl
1137  type(fstr_param_pack) :: P
1138  integer(kind=kint) :: rcode
1139 
1140  integer :: nout, nout_monit,node_monit_1 ,elem_monit_1 ,intg_monit_1
1141  integer :: ipt, idx_elpl, iout_list(6)
1142  real(kind=kreal) :: sig_y0, h_dash
1143  real(kind=kreal) :: dt, etime, eps ! dummy
1144  integer :: ITMAX ! dummy
1145  type(fstr_card_slot) :: slot
1146 
1147  slot = p%STATE%slot
1148  if( slot%first > 1 ) then
1149  write(*,*)
1150  endif
1151 
1152  ipt = 0
1153  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', 'INFINITESIMAL,NLGEOM,INFINITE ', 0, 'P', ipt )/=0 ) &
1154  return
1155  if( ipt == 2 ) p%PARAM%nlgeom = .true.
1156 
1157  ! for backward compatibility
1158  if( ipt == 3 ) then
1159  write(*,*) "Warning : !STATIC : parameter 'TYPE=INFINITE' is deprecated." &
1160  & // " Please use the replacement parameter 'TYPE=INFINITESIMAL'"
1161  endif
1162 
1163  rcode = fstr_ctrl_get_static( ctrl, &
1164  dt, etime, itmax, eps, p%SOLID%restart_nout, &
1165  idx_elpl, &
1166  iout_list, &
1167  sig_y0, h_dash, &
1168  nout, nout_monit, node_monit_1, &
1169  elem_monit_1, intg_monit_1 )
1170 
1171  if( rcode /= 0 ) call fstr_ctrl_err_stop
1172 
1173  end subroutine fstr_setup_static
1174 
1175  !-----------------------------------------------------------------------------!
1177  !-----------------------------------------------------------------------------!
1178 
1179  subroutine fstr_setup_boundary( ctrl, P )
1180  implicit none
1181  integer(kind=kint) :: ctrl
1182  type(fstr_param_pack) :: P
1183 
1184  integer(kind=kint) :: rcode
1185  character(HECMW_NAME_LEN) :: amp, rotc_name(1)
1186  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1187  integer(kind=kint),pointer :: dof_ids (:)
1188  integer(kind=kint),pointer :: dof_ide (:)
1189  real(kind=kreal),pointer :: val_ptr(:)
1190  integer(kind=kint) :: n
1191 
1192  integer(kind=kint) :: gid, istot
1193 
1194  gid = 1
1195  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1196 
1197  istot = 0
1198  rcode = fstr_ctrl_get_param_ex( ctrl, 'TOTAL ', '# ', 0, 'E', istot )
1199  if( rcode /= 0 ) call fstr_ctrl_err_stop
1200 
1201  ! get center of torque load
1202  rotc_name = ' '
1203  rcode = fstr_ctrl_get_param_ex( ctrl, 'ROT_CENTER ', '# ', 0, 'S', rotc_name )
1204  if( rcode /= 0 ) call fstr_ctrl_err_stop
1205 
1206  ! ENTIRE -----------------------------------------------
1207  p%SOLID%file_type = kbcffstr
1208 
1209  n = fstr_ctrl_get_data_line_n( ctrl )
1210  allocate( grp_id_name(n) )
1211  allocate( dof_ids(n) )
1212  allocate( dof_ide(n) )
1213  allocate( val_ptr(n) )
1214 
1215  amp = ' '
1216  val_ptr = 0.0d0
1217  if( n > 0 ) then
1218  rcode = fstr_ctrl_get_boundary( ctrl, amp, grp_id_name, hecmw_name_len, dof_ids, dof_ide, val_ptr)
1219  if( rcode /= 0 ) call fstr_ctrl_err_stop
1220  endif
1221  call fstr_solid_append_boundary( p%MESH, p%SOLID, '!BOUNDARY', gid, istot, rotc_name(1), &
1222  amp, n, grp_id_name, dof_ids, dof_ide, val_ptr )
1223 
1224  deallocate( grp_id_name )
1225  deallocate( dof_ids )
1226  deallocate( dof_ide )
1227  deallocate( val_ptr )
1228  nullify( grp_id_name )
1229  nullify( dof_ids )
1230  nullify( dof_ide )
1231  nullify( val_ptr )
1232 
1233  end subroutine fstr_setup_boundary
1234 
1235  !-----------------------------------------------------------------------------!
1237  !-----------------------------------------------------------------------------!
1238 
1239  subroutine fstr_setup_cload( ctrl, P )
1240  implicit none
1241  integer(kind=kint) :: ctrl
1242  type(fstr_param_pack) :: P
1243 
1244  integer(kind=kint) :: rcode
1245  character(HECMW_NAME_LEN) :: amp, rotc_name(1)
1246  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1247  real(kind=kreal),pointer :: val_ptr(:)
1248  integer(kind=kint),pointer :: id_ptr(:)
1249  integer(kind=kint) :: n
1250  integer(kind=kint) :: gid
1251 
1252  if( p%SOLID%file_type /= kbcffstr ) return
1253  gid = 1
1254  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1255  if( rcode /= 0 ) call fstr_ctrl_err_stop
1256 
1257  ! get center of torque load
1258  rotc_name = ' '
1259  rcode = fstr_ctrl_get_param_ex( ctrl, 'ROT_CENTER ', '# ', 0, 'S', rotc_name )
1260  if( rcode /= 0 ) call fstr_ctrl_err_stop
1261 
1262  n = fstr_ctrl_get_data_line_n( ctrl )
1263  allocate( grp_id_name(n))
1264  allocate( id_ptr(n) )
1265  allocate( val_ptr(n) )
1266  amp = ' '
1267  id_ptr = 0
1268  val_ptr = 0.0d0
1269  if( n > 0 ) then
1270  rcode = fstr_ctrl_get_cload( ctrl, amp, grp_id_name, hecmw_name_len, id_ptr, val_ptr )
1271  if( rcode /= 0 ) call fstr_ctrl_err_stop
1272  endif
1273  call fstr_solid_append_cload( p%MESH, p%SOLID, '!CLOAD', gid, rotc_name(1), &
1274  amp, n, grp_id_name, id_ptr, val_ptr )
1275 
1276  deallocate( grp_id_name )
1277  deallocate( id_ptr )
1278  deallocate( val_ptr )
1279  nullify( grp_id_name )
1280  nullify( id_ptr )
1281  nullify( val_ptr )
1282 
1283  end subroutine fstr_setup_cload
1284 
1286  subroutine fstr_setup_dload( ctrl, P )
1287  implicit none
1288  integer(kind=kint) :: ctrl
1289  type(fstr_param_pack) :: P
1290 
1291  integer(kind=kint) :: rcode
1292  character(HECMW_NAME_LEN) :: amp
1293  integer(kind=kint) :: follow
1294  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1295  real(kind=kreal),pointer :: new_params(:,:)
1296  integer(kind=kint),pointer :: lid_ptr(:)
1297  integer(kind=kint) :: n
1298  integer(kind=kint) :: gid
1299 
1300  if( p%SOLID%file_type /= kbcffstr ) return
1301 
1302  gid = 1
1303  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1304 
1305  n = fstr_ctrl_get_data_line_n( ctrl )
1306  if( n == 0 ) return
1307 
1308  allocate( grp_id_name(n))
1309  allocate( lid_ptr(n) )
1310  allocate( new_params(0:6,n))
1311  new_params = 0
1312  amp = ' '
1313  follow = p%SOLID%DLOAD_follow
1314  if( .not. p%PARAM%nlgeom ) follow = 0
1315  rcode = fstr_ctrl_get_dload( ctrl, amp, follow, &
1316  grp_id_name, hecmw_name_len, &
1317  lid_ptr, new_params )
1318  if( rcode /= 0 ) call fstr_ctrl_err_stop
1319  call fstr_solid_append_dload( p%MESH, p%SOLID, '!DLOAD', gid, follow, &
1320  amp, n, grp_id_name, lid_ptr, new_params )
1321  deallocate( grp_id_name )
1322  deallocate( lid_ptr )
1323  deallocate( new_params )
1324  nullify( grp_id_name )
1325  nullify( lid_ptr )
1326  nullify( new_params )
1327  end subroutine fstr_setup_dload
1328 
1329  !-----------------------------------------------------------------------------!
1331  !-----------------------------------------------------------------------------!
1332 
1333  subroutine fstr_setup_temperature( ctrl, P )
1334  implicit none
1335  integer(kind=kint) :: ctrl
1336  type(fstr_param_pack) :: P
1337 
1338  integer(kind=kint) :: rcode, gid
1339  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1340  real(kind=kreal),pointer :: val_ptr(:)
1341  integer(kind=kint) :: n
1342 
1343  if( p%SOLID%file_type /= kbcffstr ) return
1344 
1345  gid = 1
1346  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1347 
1348  n = fstr_ctrl_get_data_line_n( ctrl )
1349  allocate( grp_id_name(n))
1350  allocate( val_ptr(n) )
1351  val_ptr = 0.0d0
1352 
1353  rcode = fstr_ctrl_get_temperature( ctrl, &
1354  p%SOLID%TEMP_irres, &
1355  p%SOLID%TEMP_tstep, &
1356  p%SOLID%TEMP_interval, &
1357  p%SOLID%TEMP_rtype, &
1358  grp_id_name, hecmw_name_len, &
1359  val_ptr )
1360  if( rcode /= 0 ) call fstr_ctrl_err_stop
1361  if( p%SOLID%TEMP_irres == 0 ) then
1362  call fstr_solid_append_temperature( p%MESH, p%SOLID, '!TEMPERATURE', gid, n, grp_id_name, val_ptr )
1363  endif
1364 
1365  deallocate( grp_id_name )
1366  deallocate( val_ptr )
1367  nullify( grp_id_name )
1368  nullify( val_ptr )
1369 
1370  end subroutine fstr_setup_temperature
1371 
1372  !-----------------------------------------------------------------------------!
1374  !-----------------------------------------------------------------------------!
1375 
1376  subroutine fstr_setup_spring( ctrl, P )
1377  implicit none
1378  integer(kind=kint) :: ctrl
1379  type(fstr_param_pack) :: P
1380 
1381  integer(kind=kint) :: rcode, incremental
1382  character(HECMW_NAME_LEN) :: amp
1383  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1384  real(kind=kreal),pointer :: val_ptr(:)
1385  integer(kind=kint),pointer :: id_ptr(:)
1386  integer(kind=kint) :: n
1387  integer(kind=kint) :: gid
1388 
1389  if( p%SOLID%file_type /= kbcffstr ) return
1390  gid = 1
1391  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1392  n = fstr_ctrl_get_data_line_n( ctrl )
1393  if( n == 0 ) return
1394 
1395  allocate( grp_id_name(n))
1396  allocate( id_ptr(n) )
1397  allocate( val_ptr(n) )
1398  amp = ' '
1399  incremental = 0
1400  id_ptr = 0
1401  val_ptr = 0.0d0
1402  rcode = fstr_ctrl_get_spring( ctrl, amp, grp_id_name, hecmw_name_len, id_ptr, val_ptr, incremental )
1403  if( rcode /= 0 ) call fstr_ctrl_err_stop
1404  call fstr_solid_append_spring( p%MESH, p%SOLID, '!SPRING', gid, incremental, &
1405  amp, n, grp_id_name, id_ptr, val_ptr )
1406 
1407  deallocate( grp_id_name )
1408  deallocate( id_ptr )
1409  deallocate( val_ptr )
1410  nullify( grp_id_name )
1411  nullify( id_ptr )
1412  nullify( val_ptr )
1413 
1414  end subroutine fstr_setup_spring
1415 
1416  !-----------------------------------------------------------------------------!
1418  !-----------------------------------------------------------------------------!
1419 
1420  subroutine fstr_setup_velocity( ctrl, P )
1421  implicit none
1422  integer(kind=kint) :: ctrl
1423  type(fstr_param_pack) :: P
1424 
1425  integer(kind=kint) :: rcode
1426  integer(kind=kint) :: vType
1427  character(HECMW_NAME_LEN) :: amp, rotc_name(1)
1428  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1429  integer(kind=kint),pointer :: dof_ids (:)
1430  integer(kind=kint),pointer :: dof_ide (:)
1431  real(kind=kreal),pointer :: val_ptr(:)
1432  integer(kind=kint) :: n
1433  integer(kind=kint) :: gid
1434 
1435  gid = 1
1436  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1437 
1438  ! get center of rotation ( same syntax as !BOUNDARY,ROT_CENTER= )
1439  rotc_name = ' '
1440  rcode = fstr_ctrl_get_param_ex( ctrl, 'ROT_CENTER ', '# ', 0, 'S', rotc_name )
1441  if( rcode /= 0 ) call fstr_ctrl_err_stop
1442 
1443  n = fstr_ctrl_get_data_line_n( ctrl )
1444  allocate( grp_id_name(n))
1445  allocate( dof_ids(n))
1446  allocate( dof_ide(n))
1447  allocate( val_ptr(n) )
1448 
1449  vtype = kbctransit
1450  amp = ''
1451  val_ptr = 0.0d0
1452  if( n > 0 ) then
1453  rcode = fstr_ctrl_get_velocity( ctrl, vtype, amp, &
1454  grp_id_name, hecmw_name_len, &
1455  dof_ids, dof_ide, val_ptr )
1456  if( rcode /= 0 ) call fstr_ctrl_err_stop
1457  endif
1458  call fstr_solid_append_velocity( p%MESH, p%SOLID, p%DYN, '!VELOCITY', gid, vtype, rotc_name(1), &
1459  amp, n, grp_id_name, dof_ids, dof_ide, val_ptr )
1460 
1461  deallocate( grp_id_name )
1462  deallocate( dof_ids )
1463  deallocate( dof_ide )
1464  deallocate( val_ptr )
1465  nullify( grp_id_name )
1466  nullify( dof_ids )
1467  nullify( dof_ide )
1468  nullify( val_ptr )
1469 
1470  end subroutine fstr_setup_velocity
1471 
1472  !-----------------------------------------------------------------------------!
1474  !-----------------------------------------------------------------------------!
1475 
1476  subroutine fstr_setup_acceleration( ctrl, P )
1477  implicit none
1478  integer(kind=kint) :: ctrl
1479  type(fstr_param_pack) :: P
1480 
1481  integer(kind=kint) :: rcode
1482  integer(kind=kint) :: aType
1483  character(HECMW_NAME_LEN) :: amp
1484  character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
1485  integer(kind=kint),pointer :: dof_ids (:)
1486  integer(kind=kint),pointer :: dof_ide (:)
1487  real(kind=kreal),pointer :: val_ptr(:)
1488  integer(kind=kint) :: n
1489  integer(kind=kint) :: gid
1490 
1491  gid = 1
1492  rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 0, 'I', gid )
1493 
1494  n = fstr_ctrl_get_data_line_n( ctrl )
1495  if( n == 0 ) return
1496 
1497  allocate( grp_id_name(n))
1498  allocate( dof_ids(n))
1499  allocate( dof_ide(n))
1500  allocate( val_ptr(n))
1501 
1502  amp = ' '
1503  val_ptr = 0.0d0
1504  rcode = fstr_ctrl_get_acceleration( ctrl, atype, amp, &
1505  grp_id_name, hecmw_name_len, &
1506  dof_ids, dof_ide, val_ptr)
1507  if( rcode /= 0 ) call fstr_ctrl_err_stop
1508  call fstr_solid_append_acceleration( p%MESH, p%SOLID, p%DYN, '!ACCELERATION', gid, atype, &
1509  amp, n, grp_id_name, dof_ids, dof_ide, val_ptr )
1510 
1511  deallocate( grp_id_name )
1512  deallocate( dof_ids )
1513  deallocate( dof_ide )
1514  deallocate( val_ptr )
1515  nullify( grp_id_name )
1516  nullify( dof_ids )
1517  nullify( dof_ide )
1518  nullify( val_ptr )
1519  end subroutine fstr_setup_acceleration
1520 
1521  subroutine fstr_setup_solid_nastran( ctrl, hecMESH, fstrSOLID )
1522  implicit none
1523  integer(kind=kint) :: ctrl
1524  type (hecmwST_local_mesh) :: hecMESH
1525  type (fstr_solid ) :: fstrSOLID
1526  write(ilog,*) '### Error : In !BOUNDARY, TYPE=NASTRAN is not supported.'
1527  call fstr_abort( hecmw_exit_model )
1528  end subroutine fstr_setup_solid_nastran
1529 
1530  !-----------------------------------------------------------------------------!
1532  !-----------------------------------------------------------------------------!
1533  subroutine fstr_setup_contact( ctrl, P )
1534  implicit none
1535  integer(kind=kint) :: ctrl
1536  type(fstr_param_pack) :: P
1537 
1538  type(fstr_param), pointer :: fstrPARAM
1539  type(fstr_solid), pointer :: fstrSOLID
1540  integer(kind=kint) :: c_contact, n, k
1541  real(kind=kreal) :: ee, pp, rho, alpha
1542  character(len=HECMW_FILENAME_LEN) :: mName
1543  type(fstr_card_slot) :: slot
1544 
1545  slot = p%STATE%slot
1546  fstrparam => p%PARAM
1547  fstrsolid => p%SOLID
1548 
1549  n = fstr_ctrl_get_data_line_n( ctrl )
1550  c_contact = slot%first - 1
1551  if( .not. fstr_ctrl_get_contact( ctrl, n, fstrsolid%contacts(slot%first:slot%last) &
1552  ,ee, pp, rho, alpha, mname, k ) ) then
1553  write(*,*) '### Error: Fail in read in contact condition : ', c_contact
1554  write(ilog,*) '### Error: Fail in read in contact condition : ', c_contact
1555  stop hecmw_exit_input
1556  endif
1557  ! initialize contact condition (cdotp and mut are now obsolete - penalty is in tContact)
1558  if( rho>0.d0 ) cgn = rho
1559  if( alpha>0.d0 ) cgt = alpha
1560  call fstr_solid_init_contacts( p%MESH, fstrsolid, fstrparam, c_contact, n, mname, k )
1561  end subroutine fstr_setup_contact
1562 
1563  !-----------------------------------------------------------------------------!
1565  !-----------------------------------------------------------------------------!
1566  subroutine fstr_setup_embed( ctrl, P )
1567  implicit none
1568  integer(kind=kint) :: ctrl
1569  type(fstr_param_pack) :: P
1570 
1571  type(fstr_param), pointer :: fstrPARAM
1572  type(fstr_solid), pointer :: fstrSOLID
1573  integer(kind=kint) :: c_embed, n, k
1574  character(len=HECMW_FILENAME_LEN) :: mName
1575  type(fstr_card_slot) :: slot
1576 
1577  slot = p%STATE%slot
1578  fstrparam => p%PARAM
1579  fstrsolid => p%SOLID
1580 
1581  n = fstr_ctrl_get_data_line_n( ctrl )
1582  c_embed = slot%first - 1
1583  if( .not. fstr_ctrl_get_embed( ctrl, n, fstrsolid%embeds(slot%first:slot%last), mname, k ) ) then
1584  write(*,*) '### Error: Fail in read in embed condition : ', c_embed
1585  write(ilog,*) '### Error: Fail in read in embed condition : ', c_embed
1586  stop hecmw_exit_input
1587  endif
1588  call fstr_solid_init_embeds( p%MESH, fstrsolid, fstrparam, c_embed, n, mname, k )
1589  end subroutine fstr_setup_embed
1590 
1591  !-----------------------------------------------------------------------------!
1593  !-----------------------------------------------------------------------------!
1594  subroutine fstr_setup_istep( ctrl, P )
1595  implicit none
1596  integer(kind=kint) :: ctrl
1597  type(fstr_param_pack) :: P
1598 
1599  type(hecmwst_local_mesh), pointer :: hecMESH
1600  type(fstr_param), pointer :: fstrPARAM
1601  type(fstr_solid), pointer :: fstrSOLID
1602  integer(kind=kint) :: i
1603  character(len=HECMW_FILENAME_LEN) :: mName, mName2, mName3
1604  type(fstr_card_slot) :: slot
1605 
1606  slot = p%STATE%slot
1607  hecmesh => p%MESH
1608  fstrparam => p%PARAM
1609  fstrsolid => p%SOLID
1610 
1611  if( .not. fstr_ctrl_get_istep( ctrl, hecmesh, fstrsolid%step_ctrl(slot%first), mname, mname2, mname3 ) ) then
1612  write(*,*) '### Error: Fail in read in step definition : ' , slot%first
1613  write(ilog,*) '### Error: Fail in read in step definition : ', slot%first
1614  stop hecmw_exit_input
1615  endif
1616  call fstr_setup_step_convergence( fstrsolid%step_ctrl(slot%first), mname3, fstrparam%cnvparam, slot%first )
1617  if( associated(fstrparam%timepoints) ) then
1618  do i=1,size(fstrparam%timepoints)
1619  if( hecmw_streqr( fstrparam%timepoints(i)%name, mname ) ) then
1620  fstrsolid%step_ctrl(slot%first)%timepoint_id = i; exit
1621  endif
1622  enddo
1623  endif
1624  if( associated(fstrparam%ainc) ) then
1625  do i=1,size(fstrparam%ainc)-1
1626  if( hecmw_streqr( fstrparam%ainc(i)%name, mname2 ) ) then
1627  fstrsolid%step_ctrl(slot%first)%AincParam_id = i; exit
1628  endif
1629  enddo
1630  endif
1631  end subroutine fstr_setup_istep
1632 
1633  !-----------------------------------------------------------------------------!
1635  !-----------------------------------------------------------------------------!
1637  subroutine fstr_setup_step_store( ctrl, P )
1638  implicit none
1639  integer(kind=kint) :: ctrl
1640  type(fstr_param_pack) :: P
1641 
1642  type(hecmwst_local_mesh), pointer :: hecMESH
1643  type(fstr_param), pointer :: fstrPARAM
1644  type(fstr_solid), pointer :: fstrSOLID
1645  type(fstr_dynamic), pointer :: fstrDYNAMIC
1646  character(len=HECMW_FILENAME_LEN) :: mName, mName2, mName3
1647  type(fstr_card_slot) :: slot
1648 
1649  slot = p%STATE%slot
1650  hecmesh => p%MESH
1651  fstrparam => p%PARAM
1652  fstrsolid => p%SOLID
1653  fstrdynamic => p%DYN
1654 
1655  if( .not. fstr_ctrl_get_istep( ctrl, hecmesh, fstrsolid%step_ctrl(slot%first), mname, mname2, mname3 ) ) then
1656  write(*,*) '### Error: Fail in read in step definition : ' , slot%first
1657  write(ilog,*) '### Error: Fail in read in step definition : ', slot%first
1658  stop hecmw_exit_input
1659  endif
1660  call fstr_setup_step_links( fstrparam, fstrsolid, fstrdynamic, slot%first, mname, mname2, mname3 )
1661  end subroutine fstr_setup_step_store
1662 
1663  !-----------------------------------------------------------------------------!
1665  !-----------------------------------------------------------------------------!
1666  subroutine fstr_setup_section( ctrl, P )
1667  implicit none
1668  integer(kind=kint) :: ctrl
1669  type(fstr_param_pack) :: P
1670 
1671  type(hecmwst_local_mesh), pointer :: hecMESH
1672  type(fstr_solid), pointer :: fstrSOLID
1673  type(fstr_card_slot) :: slot
1674 
1675  slot = p%STATE%slot
1676  hecmesh => p%MESH
1677  fstrsolid => p%SOLID
1678 
1679  if( fstr_ctrl_get_section( ctrl, hecmesh, fstrsolid%sections )/=0 ) then
1680  write(*,*) '### Error: Fail in read in SECTION definition : ' , slot%first
1681  write(ilog,*) '### Error: Fail in read in SECTION definition : ', slot%first
1682  stop hecmw_exit_input
1683  endif
1684  end subroutine fstr_setup_section
1685 
1686  !-----------------------------------------------------------------------------!
1688  !-----------------------------------------------------------------------------!
1689  subroutine fstr_setup_elemopt( ctrl, P )
1690  implicit none
1691  integer(kind=kint) :: ctrl
1692  type(fstr_param_pack) :: P
1693 
1694  type(fstr_solid), pointer :: fstrSOLID
1695  type(fstr_card_slot) :: slot
1696 
1697  slot = p%STATE%slot
1698  fstrsolid => p%SOLID
1699 
1700  if( fstr_ctrl_get_elemopt( ctrl, fstrsolid%elemopt361 )/=0 ) then
1701  write(*,*) '### Error: Fail in read in ELEMOPT definition : ' , slot%first
1702  write(ilog,*) '### Error: Fail in read in ELEMOPT definition : ', slot%first
1703  stop hecmw_exit_input
1704  endif
1705  end subroutine fstr_setup_elemopt
1706 
1707  !-----------------------------------------------------------------------------!
1709  !-----------------------------------------------------------------------------!
1711  subroutine fstr_setup_material( ctrl, P )
1712  use mmaterial
1713  implicit none
1714  integer(kind=kint) :: ctrl
1715  type(fstr_param_pack) :: P
1716 
1717  type(hecmwst_local_mesh), pointer :: hecMESH
1718  type(fstr_solid), pointer :: fstrSOLID
1719  integer(kind=kint) :: i, cid, cache
1720  character(len=HECMW_FILENAME_LEN) :: mName
1721  type(fstr_card_slot) :: slot
1722 
1723  slot = p%STATE%slot
1724  hecmesh => p%MESH
1725  fstrsolid => p%SOLID
1726  cache = p%STATE%cache
1727 
1728  if( fstr_ctrl_get_material( ctrl, mname )/=0 ) then
1729  write(*,*) '### Error: Fail in read in material definition : ' , slot%first
1730  write(ilog,*) '### Error: Fail in read in material definition : ', slot%first
1731  stop hecmw_exit_input
1732  endif
1733  cid = 0
1734  if(cache < hecmesh%material%n_mat) then
1735  if(hecmw_streqr( hecmesh%material%mat_name(cache), mname ))then
1736  cid = cache
1737  cache = cache + 1
1738  endif
1739  endif
1740  if(cid == 0)then
1741  do i=1,hecmesh%material%n_mat
1742  if( hecmw_streqr( hecmesh%material%mat_name(i), mname ) ) then
1743  cid = i
1744  cache = i + 1
1745  exit
1746  endif
1747  enddo
1748  endif
1749  if(cid == 0)then
1750  write(*,*) '### Error: Fail in read in material definition : ' , slot%first
1751  write(ilog,*) '### Error: Fail in read in material definition : ', slot%first
1752  stop hecmw_exit_input
1753  endif
1754  fstrsolid%materials(cid)%name = hecmesh%material%mat_name(cid)
1755  if(slot%first>hecmesh%material%n_mat) call initmaterial( fstrsolid%materials(cid) )
1756  p%STATE%cid = cid
1757  p%STATE%cache = cache
1758  end subroutine fstr_setup_material
1759 
1761  integer(kind=kint) function fstr_setup_current_material( ctrl, P )
1762  implicit none
1763  integer(kind=kint) :: ctrl
1764  type(fstr_param_pack) :: p
1765 
1766  integer(kind=kint) :: rcode
1767  character(len=HECMW_NAME_LEN) :: header_name
1768 
1769  if( p%STATE%cid == 0 ) then
1770  rcode = fstr_ctrl_get_c_h_name( ctrl, header_name, hecmw_name_len )
1771  call fstr_setup_util_err_stop( '### Error: '//trim(header_name)// &
1772  ' : given before the first !MATERIAL; put it after !MATERIAL, NAME=<material name>' )
1773  endif
1774  fstr_setup_current_material = p%STATE%cid
1775  end function fstr_setup_current_material
1776 
1777  !-----------------------------------------------------------------------------!
1779  !-----------------------------------------------------------------------------!
1780  subroutine fstr_setup_elastic( ctrl, P )
1781  implicit none
1782  integer(kind=kint) :: ctrl
1783  type(fstr_param_pack) :: P
1784 
1785  type(fstr_solid), pointer :: fstrSOLID
1786  integer(kind=kint) :: cid
1787 
1788  cid = fstr_setup_current_material( ctrl, p )
1789  fstrsolid => p%SOLID
1790 
1791  if( fstr_ctrl_get_elasticity( ctrl, &
1792  fstrsolid%materials(cid)%mtype, &
1793  fstrsolid%materials(cid)%nlgeom_flag, &
1794  fstrsolid%materials(cid)%variables, &
1795  fstrsolid%materials(cid)%dict)/=0 ) then
1796  write(*,*) '### Error: Fail in read in elasticity definition : ' , cid
1797  write(ilog,*) '### Error: Fail in read in elasticity definition : ', cid
1798  stop hecmw_exit_input
1799  endif
1800  end subroutine fstr_setup_elastic
1801 
1802  !-----------------------------------------------------------------------------!
1804  !-----------------------------------------------------------------------------!
1805  subroutine fstr_setup_plastic( ctrl, P )
1806  implicit none
1807  integer(kind=kint) :: ctrl
1808  type(fstr_param_pack) :: P
1809 
1810  type(fstr_solid), pointer :: fstrSOLID
1811  integer(kind=kint) :: cid
1812 
1813  cid = fstr_setup_current_material( ctrl, p )
1814  fstrsolid => p%SOLID
1815 
1816  if( fstr_ctrl_get_plasticity( ctrl, &
1817  fstrsolid%materials(cid)%mtype, &
1818  fstrsolid%materials(cid)%nlgeom_flag, &
1819  fstrsolid%materials(cid)%variables, &
1820  fstrsolid%materials(cid)%dict)/=0 ) then
1821  write(*,*) '### Error: Fail in read in plasticity definition : ' , cid
1822  write(ilog,*) '### Error: Fail in read in plasticity definition : ', cid
1823  stop hecmw_exit_input
1824  endif
1825  end subroutine fstr_setup_plastic
1826 
1827  !-----------------------------------------------------------------------------!
1829  !-----------------------------------------------------------------------------!
1830  subroutine fstr_setup_hyperelastic( ctrl, P )
1831  implicit none
1832  integer(kind=kint) :: ctrl
1833  type(fstr_param_pack) :: P
1834 
1835  type(fstr_solid), pointer :: fstrSOLID
1836  integer(kind=kint) :: cid
1837 
1838  cid = fstr_setup_current_material( ctrl, p )
1839  fstrsolid => p%SOLID
1840 
1841  if( fstr_ctrl_get_hyperelastic( ctrl, &
1842  fstrsolid%materials(cid)%mtype, &
1843  fstrsolid%materials(cid)%nlgeom_flag, &
1844  fstrsolid%materials(cid)%variables )/=0 ) then
1845  write(*,*) '### Error: Fail in read in elasticity definition : ' , cid
1846  write(ilog,*) '### Error: Fail in read in elasticity definition : ', cid
1847  stop hecmw_exit_input
1848  endif
1849  end subroutine fstr_setup_hyperelastic
1850 
1851  !-----------------------------------------------------------------------------!
1853  !-----------------------------------------------------------------------------!
1854  subroutine fstr_setup_viscoelastic( ctrl, P )
1855  implicit none
1856  integer(kind=kint) :: ctrl
1857  type(fstr_param_pack) :: P
1858 
1859  type(fstr_solid), pointer :: fstrSOLID
1860  integer(kind=kint) :: cid
1861 
1862  cid = fstr_setup_current_material( ctrl, p )
1863  fstrsolid => p%SOLID
1864 
1865  if( fstr_ctrl_get_viscoelasticity( ctrl, &
1866  fstrsolid%materials(cid)%mtype, &
1867  fstrsolid%materials(cid)%nlgeom_flag, &
1868  fstrsolid%materials(cid)%dict)/=0 ) then
1869  write(*,*) '### Error: Fail in read in plasticity definition : ' , cid
1870  write(ilog,*) '### Error: Fail in read in plasticity definition : ', cid
1871  stop hecmw_exit_input
1872  endif
1873  end subroutine fstr_setup_viscoelastic
1874 
1875  !-----------------------------------------------------------------------------!
1877  !-----------------------------------------------------------------------------!
1878  subroutine fstr_setup_trs( ctrl, P )
1879  use mmaterial
1880  implicit none
1881  integer(kind=kint) :: ctrl
1882  type(fstr_param_pack) :: P
1883 
1884  type(fstr_solid), pointer :: fstrSOLID
1885  integer(kind=kint) :: cid
1886 
1887  cid = fstr_setup_current_material( ctrl, p )
1888  fstrsolid => p%SOLID
1889 
1890  if( fstrsolid%materials(cid)%mtype/=viscoelastic ) then
1891  write(*,*) '### WARNING: TRS can only be defined for viscoelastic material! It is ignored! '
1892  write(ilog,*) '### WARNING: TRS can only be defined for viscoelastic material! It is ignored! '
1893  else
1894  if( fstr_ctrl_get_trs( ctrl, fstrsolid%materials(cid)%mtype, fstrsolid%materials(cid)%variables)/=0 ) then
1895  write(*,*) '### Error: Fail in read in TRS definition : ' , cid
1896  write(ilog,*) '### Error: Fail in read in TRS definition : ', cid
1897  stop hecmw_exit_input
1898  endif
1899  endif
1900  end subroutine fstr_setup_trs
1901 
1902  !-----------------------------------------------------------------------------!
1904  !-----------------------------------------------------------------------------!
1905  subroutine fstr_setup_creep( ctrl, P )
1906  implicit none
1907  integer(kind=kint) :: ctrl
1908  type(fstr_param_pack) :: P
1909 
1910  type(fstr_solid), pointer :: fstrSOLID
1911  integer(kind=kint) :: cid
1912 
1913  cid = fstr_setup_current_material( ctrl, p )
1914  fstrsolid => p%SOLID
1915 
1916  if( fstr_ctrl_get_viscoplasticity( ctrl, &
1917  fstrsolid%materials(cid)%mtype, &
1918  fstrsolid%materials(cid)%nlgeom_flag, &
1919  fstrsolid%materials(cid)%dict)/=0 ) then
1920  write(*,*) '### Error: Fail in read in plasticity definition : ' , cid
1921  write(ilog,*) '### Error: Fail in read in plasticity definition : ', cid
1922  stop hecmw_exit_input
1923  endif
1924  end subroutine fstr_setup_creep
1925 
1926  !-----------------------------------------------------------------------------!
1928  !-----------------------------------------------------------------------------!
1929  subroutine fstr_setup_density( ctrl, P )
1930  implicit none
1931  integer(kind=kint) :: ctrl
1932  type(fstr_param_pack) :: P
1933 
1934  type(fstr_solid), pointer :: fstrSOLID
1935  integer(kind=kint) :: cid
1936 
1937  cid = fstr_setup_current_material( ctrl, p )
1938  fstrsolid => p%SOLID
1939 
1940  if( fstr_ctrl_get_density( ctrl, fstrsolid%materials(cid)%variables )/=0 ) then
1941  write(*,*) '### Error: Fail in read in density definition : ' , cid
1942  write(ilog,*) '### Error: Fail in read in density definition : ', cid
1943  stop hecmw_exit_input
1944  endif
1945  end subroutine fstr_setup_density
1946 
1947  !-----------------------------------------------------------------------------!
1949  !-----------------------------------------------------------------------------!
1950  subroutine fstr_setup_expansion_coeff( ctrl, P )
1951  implicit none
1952  integer(kind=kint) :: ctrl
1953  type(fstr_param_pack) :: P
1954 
1955  type(fstr_solid), pointer :: fstrSOLID
1956  integer(kind=kint) :: cid
1957 
1958  cid = fstr_setup_current_material( ctrl, p )
1959  fstrsolid => p%SOLID
1960 
1961  if( fstr_ctrl_get_expansion_coeff( ctrl, fstrsolid%materials(cid)%variables, &
1962  fstrsolid%materials(cid)%dict)/=0 ) then
1963  write(*,*) '### Error: Fail in read in expansion coefficient definition : ' , cid
1964  write(ilog,*) '### Error: Fail in read in expansion coefficient definition : ', cid
1965  stop hecmw_exit_input
1966  endif
1967  end subroutine fstr_setup_expansion_coeff
1968 
1969  !-----------------------------------------------------------------------------!
1971  !-----------------------------------------------------------------------------!
1972  subroutine fstr_setup_damping( ctrl, P )
1973  implicit none
1974  integer(kind=kint) :: ctrl
1975  type(fstr_param_pack) :: P
1976 
1977  type(fstr_solid), pointer :: fstrSOLID
1978  integer(kind=kint) :: cid
1979 
1980  cid = fstr_setup_current_material( ctrl, p )
1981  fstrsolid => p%SOLID
1982 
1983  if( fstr_ctrl_get_rayleigh_damping( ctrl, fstrsolid%materials(cid)%variables, &
1984  fstrsolid%materials(cid)%is_elem_Rayleigh_damping)/=0 ) then
1985  write(*,*) '### Error: Fail in read in damping definition : ' , cid
1986  write(ilog,*) '### Error: Fail in read in damping definition : ', cid
1987  stop hecmw_exit_input
1988  endif
1989  end subroutine fstr_setup_damping
1990 
1991  !-----------------------------------------------------------------------------!
1993  !-----------------------------------------------------------------------------!
1994  subroutine fstr_setup_fluid( ctrl, P )
1995  implicit none
1996  integer(kind=kint) :: ctrl
1997  type(fstr_param_pack) :: P
1998 
1999  type(fstr_solid), pointer :: fstrSOLID
2000  integer(kind=kint) :: cid
2001 
2002  cid = fstr_setup_current_material( ctrl, p )
2003  fstrsolid => p%SOLID
2004 
2005  if( fstr_ctrl_get_fluid( ctrl, &
2006  fstrsolid%materials(cid)%mtype, &
2007  fstrsolid%materials(cid)%nlgeom_flag, &
2008  fstrsolid%materials(cid)%variables, &
2009  fstrsolid%materials(cid)%dict)/=0 ) then
2010  write(*,*) '### Error: Fail in read in fluid definition : ' , cid
2011  write(ilog,*) '### Error: Fail in read in fluid definition : ', cid
2012  stop hecmw_exit_input
2013  endif
2014  end subroutine fstr_setup_fluid
2015 
2016  !-----------------------------------------------------------------------------!
2018  !-----------------------------------------------------------------------------!
2019  subroutine fstr_setup_spring_d( ctrl, P )
2020  implicit none
2021  integer(kind=kint) :: ctrl
2022  type(fstr_param_pack) :: P
2023 
2024  type(fstr_solid), pointer :: fstrSOLID
2025  integer(kind=kint) :: cid
2026 
2027  cid = fstr_setup_current_material( ctrl, p )
2028  fstrsolid => p%SOLID
2029 
2030  if( fstr_ctrl_get_spring_d( ctrl, &
2031  fstrsolid%materials(cid)%mtype, &
2032  fstrsolid%materials(cid)%nlgeom_flag, &
2033  fstrsolid%materials(cid)%variables_i, &
2034  fstrsolid%materials(cid)%dict)/=0 ) then
2035  write(*,*) '### Error: Fail in read in spring_d definition : ' , cid
2036  write(ilog,*) '### Error: Fail in read in spring_d definition : ', cid
2037  stop hecmw_exit_input
2038  endif
2039  end subroutine fstr_setup_spring_d
2040 
2041  !-----------------------------------------------------------------------------!
2043  !-----------------------------------------------------------------------------!
2044  subroutine fstr_setup_spring_a( ctrl, P )
2045  implicit none
2046  integer(kind=kint) :: ctrl
2047  type(fstr_param_pack) :: P
2048 
2049  type(fstr_solid), pointer :: fstrSOLID
2050  integer(kind=kint) :: cid
2051 
2052  cid = fstr_setup_current_material( ctrl, p )
2053  fstrsolid => p%SOLID
2054 
2055  if( fstr_ctrl_get_spring_a( ctrl, &
2056  fstrsolid%materials(cid)%mtype, &
2057  fstrsolid%materials(cid)%nlgeom_flag, &
2058  fstrsolid%materials(cid)%variables_i, &
2059  fstrsolid%materials(cid)%dict)/=0 ) then
2060  write(*,*) '### Error: Fail in read in spring_a definition : ' , cid
2061  write(ilog,*) '### Error: Fail in read in spring_a definition : ', cid
2062  stop hecmw_exit_input
2063  endif
2064  end subroutine fstr_setup_spring_a
2065 
2066  !-----------------------------------------------------------------------------!
2068  !-----------------------------------------------------------------------------!
2069  subroutine fstr_setup_dashpot_d( ctrl, P )
2070  implicit none
2071  integer(kind=kint) :: ctrl
2072  type(fstr_param_pack) :: P
2073 
2074  type(fstr_solid), pointer :: fstrSOLID
2075  integer(kind=kint) :: cid
2076 
2077  cid = fstr_setup_current_material( ctrl, p )
2078  fstrsolid => p%SOLID
2079 
2080  if( fstr_ctrl_get_dashpot_d( ctrl, &
2081  fstrsolid%materials(cid)%mtype, &
2082  fstrsolid%materials(cid)%nlgeom_flag, &
2083  fstrsolid%materials(cid)%variables_i, &
2084  fstrsolid%materials(cid)%dict)/=0 ) then
2085  write(*,*) '### Error: Fail in read in spring_d definition : ' , cid
2086  write(ilog,*) '### Error: Fail in read in spring_d definition : ', cid
2087  stop hecmw_exit_input
2088  endif
2089  end subroutine fstr_setup_dashpot_d
2090 
2091  !-----------------------------------------------------------------------------!
2093  !-----------------------------------------------------------------------------!
2094  subroutine fstr_setup_dashpot_a( ctrl, P )
2095  implicit none
2096  integer(kind=kint) :: ctrl
2097  type(fstr_param_pack) :: P
2098 
2099  type(fstr_solid), pointer :: fstrSOLID
2100  integer(kind=kint) :: cid
2101 
2102  cid = fstr_setup_current_material( ctrl, p )
2103  fstrsolid => p%SOLID
2104 
2105  if( fstr_ctrl_get_dashpot_a( ctrl, &
2106  fstrsolid%materials(cid)%mtype, &
2107  fstrsolid%materials(cid)%nlgeom_flag, &
2108  fstrsolid%materials(cid)%variables_i, &
2109  fstrsolid%materials(cid)%dict)/=0 ) then
2110  write(*,*) '### Error: Fail in read in spring_a definition : ' , cid
2111  write(ilog,*) '### Error: Fail in read in spring_a definition : ', cid
2112  stop hecmw_exit_input
2113  endif
2114  end subroutine fstr_setup_dashpot_a
2115 
2116  !-----------------------------------------------------------------------------!
2118  !-----------------------------------------------------------------------------!
2119  subroutine fstr_setup_user_material( ctrl, P )
2120  implicit none
2121  integer(kind=kint) :: ctrl
2122  type(fstr_param_pack) :: P
2123 
2124  type(fstr_solid), pointer :: fstrSOLID
2125  integer(kind=kint) :: cid
2126 
2127  cid = fstr_setup_current_material( ctrl, p )
2128  fstrsolid => p%SOLID
2129 
2130  if( fstr_ctrl_get_usermaterial( ctrl, fstrsolid%materials(cid)%mtype, &
2131  fstrsolid%materials(cid)%nlgeom_flag, fstrsolid%materials(cid)%nfstatus, &
2132  fstrsolid%materials(cid)%variables(101:) )/=0 ) then
2133  write(*,*) '### Error: Fail in read in user defined material : ' , cid
2134  write(ilog,*) '### Error: Fail in read in user defined material : ', cid
2135  stop hecmw_exit_input
2136  endif
2137  end subroutine fstr_setup_user_material
2138 
2139  !-----------------------------------------------------------------------------!
2141  !-----------------------------------------------------------------------------!
2142  subroutine fstr_setup_output_res( ctrl, P )
2143  implicit none
2144  integer(kind=kint) :: ctrl
2145  type(fstr_param_pack) :: P
2146 
2147  type(hecmwst_local_mesh), pointer :: hecMESH
2148  type(fstr_solid), pointer :: fstrSOLID
2149  integer(kind=kint) :: c_output, i
2150 
2151  hecmesh => p%MESH
2152  fstrsolid => p%SOLID
2153 
2154  c_output=3
2155  if( .not. fstr_ctrl_get_outitem( ctrl, hecmesh, fstrsolid%output_ctrl(c_output)%outinfo ) ) then
2156  write(*,*) '### Error: Fail in read in node output definition : ' , c_output
2157  write(ilog,*) '### Error: Fail in read in node output definition : ', c_output
2158  stop hecmw_exit_input
2159  endif
2160  if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name /= 'ALL' ) then
2161  c_output=2
2162  do i=1,hecmesh%node_group%n_grp
2163  if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name == hecmesh%node_group%grp_name(i) ) then
2164  fstrsolid%output_ctrl(c_output)%outinfo%grp_id = i; exit
2165  endif
2166  enddo
2167  endif
2168  end subroutine fstr_setup_output_res
2169 
2170  !-----------------------------------------------------------------------------!
2172  !-----------------------------------------------------------------------------!
2173  subroutine fstr_setup_output_vis( ctrl, P )
2174  implicit none
2175  integer(kind=kint) :: ctrl
2176  type(fstr_param_pack) :: P
2177 
2178  type(hecmwst_local_mesh), pointer :: hecMESH
2179  type(fstr_solid), pointer :: fstrSOLID
2180  integer(kind=kint) :: c_output, i
2181 
2182  hecmesh => p%MESH
2183  fstrsolid => p%SOLID
2184 
2185  c_output=4
2186  if( .not. fstr_ctrl_get_outitem( ctrl, hecmesh, fstrsolid%output_ctrl(c_output)%outinfo ) ) then
2187  write(*,*) '### Error: Fail in read in element output definition : ' , c_output
2188  write(ilog,*) '### Error: Fail in read in element output definition : ', c_output
2189  stop hecmw_exit_input
2190  endif
2191  if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name /= 'ALL' ) then
2192  c_output=2
2193  do i=1,hecmesh%node_group%n_grp
2194  if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name == hecmesh%node_group%grp_name(i) ) then
2195  fstrsolid%output_ctrl(c_output)%outinfo%grp_id = i; exit
2196  endif
2197  enddo
2198  endif
2199  end subroutine fstr_setup_output_vis
2200 
2201  !-----------------------------------------------------------------------------!
2203  !-----------------------------------------------------------------------------!
2204  subroutine fstr_setup_uload( ctrl, P )
2205  implicit none
2206  integer(kind=kint) :: ctrl
2207  type(fstr_param_pack) :: P
2208 
2209  if( fstr_ctrl_get_userload( ctrl )/=0 ) then
2210  write(*,*) '### Error: Fail in read in ULOAD definition : '
2211  write(ilog,*) '### Error: Fail in read in ULOAD definition : '
2212  stop hecmw_exit_input
2213  endif
2214  end subroutine fstr_setup_uload
2215 
2216  !-----------------------------------------------------------------------------!
2218  !-----------------------------------------------------------------------------!
2220  subroutine fstr_solid_append_boundary( hecMESH, fstrSOLID, header_name, gid, istot, rotc_name, &
2221  amp_name, n, grp_names, dof_ids, dof_ide, vals )
2222  implicit none
2223  type(hecmwst_local_mesh), target :: hecMESH
2224  type(fstr_solid) :: fstrSOLID
2225  character(len=*), intent(in) :: header_name
2226  integer(kind=kint), intent(in) :: gid
2227  integer(kind=kint), intent(in) :: istot
2228  character(len=HECMW_NAME_LEN), intent(in) :: rotc_name
2229  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2230  integer(kind=kint), intent(in) :: n
2231  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2232  integer(kind=kint), intent(in) :: dof_ids(:)
2233  integer(kind=kint), intent(in) :: dof_ide(:)
2234  real(kind=kreal), intent(in) :: vals(:)
2235 
2236  character(len=HECMW_NAME_LEN) :: rotc(1)
2237  integer(kind=kint) :: amp_id, rotc_id(1), n_rotc
2238  integer(kind=kint) :: i, old_size, new_size
2239 
2240  rotc_id = -1
2241  n_rotc = -1
2242  if( rotc_name /= ' ' ) then
2243  if( istot /= 0 ) call fstr_setup_util_err_stop( 'fstr control file error : '//header_name// &
2244  ' : rotational boundary cannot be specified with total value' )
2245  fstrsolid%BOUNDARY_ngrp_rot = fstrsolid%BOUNDARY_ngrp_rot + 1
2246  n_rotc = fstrsolid%BOUNDARY_ngrp_rot
2247  rotc(1) = rotc_name
2248  call node_grp_name_to_id_ex( hecmesh, header_name//',ROT_CENTER=', 1, rotc, rotc_id )
2249  endif
2250 
2251  if( n == 0 ) return
2252  old_size = fstrsolid%BOUNDARY_ngrp_tot
2253  new_size = old_size + n
2254  fstrsolid%BOUNDARY_ngrp_tot = new_size
2255  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_GRPID, old_size, new_size )
2256  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_ID, old_size, new_size )
2257  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_type, old_size, new_size )
2258  call hecmw_expand_real_array (fstrsolid%BOUNDARY_ngrp_val, old_size, new_size )
2259  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_amp, old_size, new_size )
2260  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_istot, old_size, new_size )
2261  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_rotID, old_size, new_size )
2262  call hecmw_expand_integer_array (fstrsolid%BOUNDARY_ngrp_centerID, old_size, new_size )
2263 
2264  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2265  fstrsolid%BOUNDARY_ngrp_GRPID(old_size+1:new_size) = gid
2266  call node_grp_name_to_id_ex( hecmesh, header_name, n, grp_names, fstrsolid%BOUNDARY_ngrp_ID(old_size+1:))
2267  fstrsolid%BOUNDARY_ngrp_istot(old_size+1:new_size) = istot
2268 
2269  ! set up information about rotation ( default value is set if ROT_CENTER is not given.)
2270  fstrsolid%BOUNDARY_ngrp_rotID(old_size+1:) = n_rotc
2271  fstrsolid%BOUNDARY_ngrp_centerID(old_size+1:) = rotc_id(1)
2272 
2273  do i = 1, n
2274  if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) ) then
2275  call fstr_setup_util_err_stop( 'fstr control file error : '//header_name// &
2276  ' : range of dof_ids and dof_ide is from 1 to 6' )
2277  end if
2278  fstrsolid%BOUNDARY_ngrp_val(old_size+i) = vals(i)
2279  fstrsolid%BOUNDARY_ngrp_type(old_size+i) = 10 * dof_ids(i) + dof_ide(i)
2280  fstrsolid%BOUNDARY_ngrp_amp(old_size+i) = amp_id
2281  end do
2282 
2283  end subroutine fstr_solid_append_boundary
2284 
2285  !-----------------------------------------------------------------------------!
2287  !-----------------------------------------------------------------------------!
2289  subroutine fstr_solid_append_cload( hecMESH, fstrSOLID, header_name, gid, rotc_name, &
2290  amp_name, n, grp_names, dofs, vals )
2291  implicit none
2292  type(hecmwst_local_mesh), target :: hecMESH
2293  type(fstr_solid) :: fstrSOLID
2294  character(len=*), intent(in) :: header_name
2295  integer(kind=kint), intent(in) :: gid
2296  character(len=HECMW_NAME_LEN), intent(in) :: rotc_name
2297  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2298  integer(kind=kint), intent(in) :: n
2299  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2300  integer(kind=kint), intent(in) :: dofs(:)
2301  real(kind=kreal), intent(in) :: vals(:)
2302 
2303  character(len=HECMW_NAME_LEN) :: rotc(1)
2304  integer(kind=kint) :: amp_id, rotc_id(1), n_rotc
2305  integer(kind=kint) :: i, old_size, new_size
2306  integer(kind=kint) :: ngrp_id, nnode_grp
2307  character(len=HECMW_MSG_LEN) :: msg(2)
2308 
2309  rotc_id = -1
2310  n_rotc = -1
2311  if( rotc_name /= ' ' ) then
2312  fstrsolid%CLOAD_ngrp_rot = fstrsolid%CLOAD_ngrp_rot + 1
2313  n_rotc = fstrsolid%CLOAD_ngrp_rot
2314  rotc(1) = rotc_name
2315  call node_grp_name_to_id_ex( hecmesh, header_name//',ROT_CENTER=', 1, rotc, rotc_id )
2316  endif
2317 
2318  if( n == 0 ) return
2319  old_size = fstrsolid%CLOAD_ngrp_tot
2320  new_size = old_size + n
2321  fstrsolid%CLOAD_ngrp_tot = new_size
2322  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_GRPID, old_size, new_size )
2323  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_ID, old_size, new_size )
2324  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_DOF, old_size, new_size )
2325  call hecmw_expand_real_array ( fstrsolid%CLOAD_ngrp_val, old_size, new_size )
2326  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_amp, old_size, new_size )
2327  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_rotID, old_size, new_size )
2328  call hecmw_expand_integer_array ( fstrsolid%CLOAD_ngrp_centerID, old_size, new_size )
2329 
2330  ! set up information about torque load ( default value is set if ROT_CENTER is not given.)
2331  fstrsolid%CLOAD_ngrp_rotID(old_size+1:) = n_rotc
2332  fstrsolid%CLOAD_ngrp_centerID(old_size+1:) = rotc_id(1)
2333 
2334  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2335  do i=1,n
2336  fstrsolid%CLOAD_ngrp_amp(old_size+i) = amp_id
2337  fstrsolid%CLOAD_ngrp_DOF(old_size+i) = dofs(i)
2338  fstrsolid%CLOAD_ngrp_val(old_size+i) = vals(i)
2339  end do
2340  fstrsolid%CLOAD_ngrp_GRPID(old_size+1:new_size) = gid
2341  call node_grp_name_to_id_ex( hecmesh, header_name, n, grp_names, fstrsolid%CLOAD_ngrp_ID(old_size+1:))
2342 
2343  ! the refinement adds nodes to the group, so the load given to each node of the group
2344  ! sums up to more than intended before the refinement
2345  if( hecmesh%n_refine > 0 ) then
2346  do i=1,n
2347  ngrp_id = fstrsolid%CLOAD_ngrp_ID(old_size+i)
2348  nnode_grp = hecmw_ngrp_get_number(hecmesh, ngrp_id)
2349  if( nnode_grp > 1 .and. hecmesh%my_rank == 0 ) then
2350  msg(1) = ' ### Warning: '//header_name//' on a refined mesh'
2351  write(msg(2),'(a,a,a,i0,a)') ' node group "', trim(hecmesh%node_group%grp_name(ngrp_id)), &
2352  '" now has ', nnode_grp, ' nodes; the same load is applied to each of them'
2353  write(*,'(/a/a/)') trim(msg(1)), trim(msg(2))
2354  write(ilog,'(/a/a/)') trim(msg(1)), trim(msg(2))
2355  endif
2356  enddo
2357  endif
2358 
2359  end subroutine fstr_solid_append_cload
2360 
2361  !-----------------------------------------------------------------------------!
2363  !-----------------------------------------------------------------------------!
2364 
2365  subroutine fstr_expand_dload_array( array, old_size, new_size )
2366  implicit none
2367  real(kind=kreal), pointer :: array(:,:)
2368  integer(kind=kint) :: old_size, new_size, i, j
2369  real(kind=kreal), pointer :: temp(:,:)
2370 
2371  if( old_size >= new_size ) then
2372  return
2373  end if
2374 
2375  if( associated( array ) ) then
2376  allocate(temp(0:6, old_size))
2377  temp = array
2378  deallocate(array)
2379  allocate(array(0:6, new_size))
2380  array = 0
2381  do i=1,old_size
2382  do j=0,6
2383  array(j,i) = temp(j,i)
2384  end do
2385  end do
2386  deallocate(temp)
2387  else
2388  allocate(array(0:6, new_size))
2389  array = 0
2390  end if
2391  end subroutine fstr_expand_dload_array
2392 
2393  !-----------------------------------------------------------------------------!
2395  !-----------------------------------------------------------------------------!
2397  subroutine fstr_solid_append_dload( hecMESH, fstrSOLID, header_name, gid, follow, &
2398  amp_name, n, grp_names, lids, params )
2399  implicit none
2400  type(hecmwst_local_mesh), target :: hecmesh
2401  type(fstr_solid) :: fstrSOLID
2402  character(len=*), intent(in) :: header_name
2403  integer(kind=kint), intent(in) :: gid
2404  integer(kind=kint), intent(in) :: follow
2405  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2406  integer(kind=kint), intent(in) :: n
2407  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2408  integer(kind=kint), intent(in) :: lids(:)
2409  real(kind=kreal), intent(in) :: params(0:,:)
2410 
2411  logical, allocatable :: fg_surface(:)
2412  integer(kind=kint) :: amp_id
2413  integer(kind=kint) :: i, j, old_size, new_size
2414 
2415  if( n == 0 ) return
2416  old_size = fstrsolid%DLOAD_ngrp_tot
2417  new_size = old_size + n
2418  fstrsolid%DLOAD_ngrp_tot = new_size
2419  call hecmw_expand_integer_array ( fstrsolid%DLOAD_ngrp_GRPID, old_size, new_size )
2420  call hecmw_expand_integer_array ( fstrsolid%DLOAD_ngrp_ID, old_size, new_size )
2421  call hecmw_expand_integer_array ( fstrsolid%DLOAD_ngrp_LID, old_size, new_size )
2422  call hecmw_expand_integer_array ( fstrsolid%DLOAD_ngrp_amp, old_size, new_size )
2423  call fstr_expand_dload_array ( fstrsolid%DLOAD_ngrp_params, old_size, new_size )
2424 
2425  allocate( fg_surface(n) )
2426  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2427  fstrsolid%DLOAD_follow = follow
2428  do i=1,n
2429  fstrsolid%DLOAD_ngrp_amp(old_size+i) = amp_id
2430  fstrsolid%DLOAD_ngrp_LID(old_size+i) = lids(i)
2431  do j=0, 6
2432  fstrsolid%DLOAD_ngrp_params(j,old_size+i) = params(j,i)
2433  end do
2434  fg_surface(i) = ( lids(i) == 100 )
2435  end do
2436  fstrsolid%DLOAD_ngrp_GRPID(old_size+1:new_size) = gid
2437  call dload_grp_name_to_id_ex( hecmesh, n, grp_names, fg_surface, fstrsolid%DLOAD_ngrp_ID(old_size+1:))
2438  deallocate( fg_surface )
2439 
2440  end subroutine fstr_solid_append_dload
2441 
2442  !-----------------------------------------------------------------------------!
2444  !-----------------------------------------------------------------------------!
2446  subroutine fstr_solid_append_temperature( hecMESH, fstrSOLID, header_name, gid, n, grp_names, vals )
2447  implicit none
2448  type(hecmwst_local_mesh), target :: hecMESH
2449  type(fstr_solid) :: fstrSOLID
2450  character(len=*), intent(in) :: header_name
2451  integer(kind=kint), intent(in) :: gid
2452  integer(kind=kint), intent(in) :: n
2453  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2454  real(kind=kreal), intent(in) :: vals(:)
2455 
2456  integer(kind=kint) :: i, old_size, new_size
2457 
2458  if( n == 0 ) return
2459  old_size = fstrsolid%TEMP_ngrp_tot
2460  new_size = old_size + n
2461  call hecmw_expand_integer_array ( fstrsolid%TEMP_ngrp_GRPID, old_size, new_size )
2462  call hecmw_expand_integer_array ( fstrsolid%TEMP_ngrp_ID, old_size, new_size )
2463  call hecmw_expand_real_array ( fstrsolid%TEMP_ngrp_val,old_size, new_size )
2464 
2465  do i = 1, n
2466  fstrsolid%TEMP_ngrp_val(old_size+i) = vals(i)
2467  enddo
2468  fstrsolid%TEMP_ngrp_GRPID(old_size+1:new_size) = gid
2469  fstrsolid%TEMP_ngrp_tot = new_size
2470  call node_grp_name_to_id_ex( hecmesh, header_name, n, grp_names, fstrsolid%TEMP_ngrp_ID(old_size+1:))
2471 
2472  end subroutine fstr_solid_append_temperature
2473 
2474  !-----------------------------------------------------------------------------!
2476  !-----------------------------------------------------------------------------!
2477  subroutine fstr_solid_append_spring( hecMESH, fstrSOLID, header_name, gid, incremental, &
2478  amp_name, n, grp_names, dofs, vals )
2479  implicit none
2480  type(hecmwst_local_mesh), target :: hecMESH
2481  type(fstr_solid) :: fstrSOLID
2482  character(len=*), intent(in) :: header_name
2483  integer(kind=kint), intent(in) :: gid
2484  integer(kind=kint), intent(in) :: incremental
2485  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2486  integer(kind=kint), intent(in) :: n
2487  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2488  integer(kind=kint), intent(in) :: dofs(:)
2489  real(kind=kreal), intent(in) :: vals(:)
2490 
2491  integer(kind=kint) :: amp_id
2492  integer(kind=kint) :: i, old_size, new_size
2493 
2494  if( n == 0 ) return
2495  old_size = fstrsolid%SPRING_ngrp_tot
2496  new_size = old_size + n
2497  fstrsolid%SPRING_ngrp_tot = new_size
2498  call hecmw_expand_integer_array ( fstrsolid%SPRING_ngrp_GRPID, old_size, new_size )
2499  call hecmw_expand_integer_array ( fstrsolid%SPRING_ngrp_ID, old_size, new_size )
2500  call hecmw_expand_integer_array ( fstrsolid%SPRING_ngrp_DOF, old_size, new_size )
2501  call hecmw_expand_real_array ( fstrsolid%SPRING_ngrp_val, old_size, new_size )
2502  call hecmw_expand_integer_array ( fstrsolid%SPRING_ngrp_amp, old_size, new_size )
2503  call hecmw_expand_integer_array ( fstrsolid%SPRING_incremental, old_size, new_size )
2504 
2505  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2506  do i=1,n
2507  fstrsolid%SPRING_ngrp_amp(old_size+i) = amp_id
2508  fstrsolid%SPRING_ngrp_DOF(old_size+i) = dofs(i)
2509  fstrsolid%SPRING_ngrp_val(old_size+i) = vals(i)
2510  end do
2511  fstrsolid%SPRING_ngrp_GRPID(old_size+1:new_size) = gid
2512  call node_grp_name_to_id_ex( hecmesh, header_name, n, grp_names, fstrsolid%SPRING_ngrp_ID(old_size+1:))
2513  fstrsolid%SPRING_incremental(old_size+1:new_size) = incremental
2514 
2515  end subroutine fstr_solid_append_spring
2516 
2517  !-----------------------------------------------------------------------------!
2519  !-----------------------------------------------------------------------------!
2522  subroutine fstr_solid_append_velocity( hecMESH, fstrSOLID, fstrDYNAMIC, header_name, gid, vtype, &
2523  rotc_name, amp_name, n, grp_names, dof_ids, dof_ide, vals )
2524  implicit none
2525  type(hecmwst_local_mesh), target :: hecMESH
2526  type(fstr_solid) :: fstrSOLID
2527  type(fstr_dynamic) :: fstrDYNAMIC
2528  character(len=*), intent(in) :: header_name
2529  integer(kind=kint), intent(in) :: gid
2530  integer(kind=kint), intent(in) :: vtype
2531  character(len=HECMW_NAME_LEN), intent(in) :: rotc_name
2532  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2533  integer(kind=kint), intent(in) :: n
2534  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2535  integer(kind=kint), intent(in) :: dof_ids(:)
2536  integer(kind=kint), intent(in) :: dof_ide(:)
2537  real(kind=kreal), intent(in) :: vals(:)
2538 
2539  character(len=HECMW_NAME_LEN) :: rotc(1)
2540  integer(kind=kint) :: amp_id, rotc_id(1), n_rotc
2541  integer(kind=kint) :: i, j, old_size, new_size
2542 
2543  rotc_id = -1
2544  n_rotc = -1
2545  if( rotc_name /= ' ' ) then
2546  fstrsolid%VELOCITY_ngrp_rot = fstrsolid%VELOCITY_ngrp_rot + 1
2547  n_rotc = fstrsolid%VELOCITY_ngrp_rot
2548  rotc(1) = rotc_name
2549  call node_grp_name_to_id_ex( hecmesh, header_name//',ROT_CENTER=', 1, rotc, rotc_id )
2550  endif
2551 
2552  if( n == 0 ) return
2553  old_size = fstrsolid%VELOCITY_ngrp_tot
2554  new_size = old_size + n
2555  fstrsolid%VELOCITY_ngrp_tot = new_size
2556 
2557  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_GRPID, old_size, new_size )
2558  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_ID , old_size, new_size )
2559  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_type, old_size, new_size )
2560  call hecmw_expand_real_array (fstrsolid%VELOCITY_ngrp_val , old_size, new_size )
2561  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_amp , old_size, new_size )
2562  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_rotID, old_size, new_size )
2563  call hecmw_expand_integer_array (fstrsolid%VELOCITY_ngrp_centerID, old_size, new_size )
2564 
2565  fstrsolid%VELOCITY_type = vtype
2566  if( vtype == kbcinitial ) fstrdynamic%VarInitialize = .true.
2567  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2568  call node_grp_name_to_id_ex( hecmesh, header_name, &
2569  n, grp_names, fstrsolid%VELOCITY_ngrp_ID(old_size+1:))
2570  fstrsolid%VELOCITY_ngrp_GRPID(old_size+1:new_size) = gid
2571 
2572  ! set up information about rotation ( default value is set if ROT_CENTER is not given.)
2573  fstrsolid%VELOCITY_ngrp_rotID(old_size+1:) = n_rotc
2574  fstrsolid%VELOCITY_ngrp_centerID(old_size+1:) = rotc_id(1)
2575 
2576  j = old_size+1
2577  do i = 1, n
2578  if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) ) then
2579  call fstr_setup_util_err_stop( 'fstr control file error : '//header_name// &
2580  ' : range of dof_ids and dof_ide is from 1 to 6' )
2581  end if
2582  fstrsolid%VELOCITY_ngrp_type(j) = 10 * dof_ids(i) + dof_ide(i)
2583  fstrsolid%VELOCITY_ngrp_amp(j) = amp_id
2584  fstrsolid%VELOCITY_ngrp_val(old_size+i) = vals(i)
2585  j = j+1
2586  end do
2587 
2588  end subroutine fstr_solid_append_velocity
2589 
2590  !-----------------------------------------------------------------------------!
2592  !-----------------------------------------------------------------------------!
2594  subroutine fstr_solid_append_acceleration( hecMESH, fstrSOLID, fstrDYNAMIC, header_name, gid, atype, &
2595  amp_name, n, grp_names, dof_ids, dof_ide, vals )
2596  implicit none
2597  type(hecmwst_local_mesh), target :: hecMESH
2598  type(fstr_solid) :: fstrSOLID
2599  type(fstr_dynamic) :: fstrDYNAMIC
2600  character(len=*), intent(in) :: header_name
2601  integer(kind=kint), intent(in) :: gid
2602  integer(kind=kint), intent(in) :: atype
2603  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2604  integer(kind=kint), intent(in) :: n
2605  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2606  integer(kind=kint), intent(in) :: dof_ids(:)
2607  integer(kind=kint), intent(in) :: dof_ide(:)
2608  real(kind=kreal), intent(in) :: vals(:)
2609 
2610  integer(kind=kint) :: amp_id
2611  integer(kind=kint) :: i, j, old_size, new_size
2612 
2613  if( n == 0 ) return
2614  old_size = fstrsolid%ACCELERATION_ngrp_tot
2615  new_size = old_size + n
2616  fstrsolid%ACCELERATION_ngrp_tot = new_size
2617 
2618  call hecmw_expand_integer_array (fstrsolid%ACCELERATION_ngrp_GRPID, old_size, new_size )
2619  call hecmw_expand_integer_array (fstrsolid%ACCELERATION_ngrp_ID , old_size, new_size )
2620  call hecmw_expand_integer_array (fstrsolid%ACCELERATION_ngrp_type, old_size, new_size )
2621  call hecmw_expand_real_array (fstrsolid%ACCELERATION_ngrp_val , old_size, new_size )
2622  call hecmw_expand_integer_array (fstrsolid%ACCELERATION_ngrp_amp , old_size, new_size )
2623 
2624  fstrsolid%ACCELERATION_type = atype
2625  if( atype == kbcinitial )fstrdynamic%VarInitialize = .true.
2626  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2627  call node_grp_name_to_id_ex( hecmesh, header_name, &
2628  n, grp_names, fstrsolid%ACCELERATION_ngrp_ID(old_size+1:))
2629  fstrsolid%ACCELERATION_ngrp_GRPID(old_size+1:new_size) = gid
2630 
2631  j = old_size+1
2632  do i = 1, n
2633  if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) ) then
2634  call fstr_setup_util_err_stop( 'fstr control file error : '//header_name// &
2635  ' : range of dof_ids and dof_ide is from 1 to 6' )
2636  end if
2637  fstrsolid%ACCELERATION_ngrp_type(j) = 10 * dof_ids(i) + dof_ide(i)
2638  fstrsolid%ACCELERATION_ngrp_amp(j) = amp_id
2639  fstrsolid%ACCELERATION_ngrp_val(old_size+i) = vals(i)
2640  j = j+1
2641  end do
2642 
2643  end subroutine fstr_solid_append_acceleration
2644 
2645  !-----------------------------------------------------------------------------!
2647  !-----------------------------------------------------------------------------!
2648  subroutine fstr_solid_append_couple( hecMESH, fstrSOLID, fstrPARAM, header_name, n, grp_names )
2649  implicit none
2650  type(hecmwst_local_mesh), target :: hecMESH
2651  type(fstr_solid) :: fstrSOLID
2652  type(fstr_param) :: fstrPARAM
2653  character(len=*), intent(in) :: header_name
2654  integer(kind=kint), intent(in) :: n
2655  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2656 
2657  integer(kind=kint) :: old_size, new_size
2658 
2659  if( n == 0 ) return
2660  old_size = fstrsolid%COUPLE_ngrp_tot
2661  new_size = old_size + n
2662  fstrsolid%COUPLE_ngrp_tot = new_size
2663 
2664  call hecmw_expand_integer_array ( fstrsolid%COUPLE_ngrp_ID, old_size, new_size )
2665 
2666  call surf_grp_name_to_id_ex( hecmesh, header_name, &
2667  n, grp_names, fstrsolid%COUPLE_ngrp_ID(old_size+1:))
2668 
2669  fstrparam%fg_couple = 1
2670 
2671  end subroutine fstr_solid_append_couple
2672 
2673  !-----------------------------------------------------------------------------!
2675  !-----------------------------------------------------------------------------!
2676  subroutine fstr_solid_append_element_activation( hecMESH, fstrSOLID, header_name, gid, &
2677  amp_name, eps, measure, state, n, grp_names, thlow, thup )
2678  implicit none
2679  type(hecmwst_local_mesh), target :: hecMESH
2680  type(fstr_solid) :: fstrSOLID
2681  character(len=*), intent(in) :: header_name
2682  integer(kind=kint), intent(in) :: gid
2683  character(len=HECMW_NAME_LEN), intent(in) :: amp_name
2684  real(kind=kreal), intent(in) :: eps
2685  integer(kind=kint), intent(in) :: measure
2686  integer(kind=kint), intent(in) :: state
2687  integer(kind=kint), intent(in) :: n
2688  character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
2689  real(kind=kreal), intent(in) :: thlow(:)
2690  real(kind=kreal), intent(in) :: thup(:)
2691 
2692  integer(kind=kint) :: amp_id
2693  integer(kind=kint) :: i, old_size, new_size
2694 
2695  if( n == 0 ) return
2696  old_size = fstrsolid%elemact%ELEMACT_egrp_tot
2697  new_size = old_size + n
2698  fstrsolid%elemact%ELEMACT_egrp_tot = new_size
2699 
2700  call hecmw_expand_integer_array ( fstrsolid%elemact%ELEMACT_egrp_GRPID, old_size, new_size )
2701  call hecmw_expand_integer_array ( fstrsolid%elemact%ELEMACT_egrp_ID, old_size, new_size )
2702  call hecmw_expand_integer_array ( fstrsolid%elemact%ELEMACT_egrp_amp, old_size, new_size )
2703  call hecmw_expand_real_array ( fstrsolid%elemact%ELEMACT_egrp_eps, old_size, new_size )
2704  call hecmw_expand_integer_array ( fstrsolid%elemact%ELEMACT_egrp_depends, old_size, new_size )
2705  call hecmw_expand_real_array ( fstrsolid%elemact%ELEMACT_egrp_ts_lower, old_size, new_size )
2706  call hecmw_expand_real_array ( fstrsolid%elemact%ELEMACT_egrp_ts_upper, old_size, new_size )
2707  call hecmw_expand_integer_array ( fstrsolid%elemact%ELEMACT_egrp_state, old_size, new_size )
2708 
2709  call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
2710  do i=1,n
2711  fstrsolid%elemact%ELEMACT_egrp_amp(old_size+i) = amp_id
2712  fstrsolid%elemact%ELEMACT_egrp_eps(old_size+i) = eps
2713  end do
2714  fstrsolid%elemact%ELEMACT_egrp_GRPID(old_size+1:new_size) = gid
2715  fstrsolid%elemact%ELEMACT_egrp_depends(old_size+1:new_size) = measure
2716  fstrsolid%elemact%ELEMACT_egrp_ts_lower(old_size+1:new_size) = thlow(1:n)
2717  fstrsolid%elemact%ELEMACT_egrp_ts_upper(old_size+1:new_size) = thup(1:n)
2718  fstrsolid%elemact%ELEMACT_egrp_state(old_size+1:new_size) = state
2719 
2720  call elem_grp_name_to_id_ex( hecmesh, header_name, n, grp_names, fstrsolid%elemact%ELEMACT_egrp_ID(old_size+1:))
2721 
2722  end subroutine fstr_solid_append_element_activation
2723 
2724  !-----------------------------------------------------------------------------!
2726  !-----------------------------------------------------------------------------!
2729  subroutine fstr_solid_init_contacts( hecMESH, fstrSOLID, fstrPARAM, is, n, cparam_name, smoothing )
2730  implicit none
2731  type(hecmwst_local_mesh), pointer :: hecMESH
2732  type(fstr_solid) :: fstrSOLID
2733  type(fstr_param) :: fstrPARAM
2734  integer(kind=kint), intent(in) :: is
2735  integer(kind=kint), intent(in) :: n
2736  character(len=HECMW_NAME_LEN), intent(in) :: cparam_name
2737  integer(kind=kint), intent(in) :: smoothing
2738 
2739  integer(kind=kint) :: i, cparam_id
2740  integer(kind=kint) :: ss_nslav, ss_nmas_vis, ss_nmas_glob, ss_bad ! MORTAR=YES visibility guard scratch
2741  logical :: isOK
2742 
2743  cparam_id = 0
2744  do i=1,size(fstrparam%contactparam)-1
2745  if( hecmw_streqr( fstrparam%contactparam(i)%name, cparam_name ) ) then
2746  cparam_id = i; exit
2747  endif
2748  enddo
2749  do i=1,n
2750  fstrsolid%contacts(is+i)%smoothing = smoothing
2751  if( .not. fstr_contact_check( fstrsolid%contacts(is+i), hecmesh ) ) then
2752  write(*,*) '### Error: Inconsistence in contact and surface definition : ' , i+is
2753  write(ilog,*) '### Error: Inconsistence in contact and surface definition : ', i+is
2754  stop hecmw_exit_model
2755  else
2756  isok = fstr_contact_init( fstrsolid%contacts(is+i), hecmesh, fstrparam%contactparam(cparam_id))
2757  ! !CONTACT_ALGO, FRICTION_CONE=FOLLOW gives up the symmetry of the ALagrange
2758  ! friction terms; see getContactStiffness_Alag
2759  fstrsolid%contacts(is+i)%symmetric = .not. fstrparam%fric_cone_follow
2760  fstrsolid%contacts(is+i)%eps_fric_band = fstrparam%eps_fric_band
2761  endif
2762  if( fstrsolid%contacts(is+i)%method == contacts2s ) then
2763  ! Only the static path is wired for MORTAR=YES. The implicit dynamic solver calls
2764  ! the shared scan / matrix connectivity / stiffness routines, so the pair would be
2765  ! dispatched to the mortar code, but it never calls fstr_begin_lambda_txn /
2766  ! fstr_commit_lambda_txn and the multipliers would not advance over the substeps.
2767  ! The explicit solver applies the NODE-SURF scan to every pair regardless of the
2768  ! method. Both would be silent, so this must be an error.
2769  ! ELEMCHECK and NZPROF run no analysis at all (fstr_input_precheck returns before
2770  ! the solver dispatch and never touches the contact pairs), so they are let through.
2771  if( fstrparam%solution_type /= kststatic .and. &
2772  & fstrparam%solution_type /= kstprecheck .and. &
2773  & fstrparam%solution_type /= kstnzprof ) then
2774  write(*,*) '### Error: MORTAR=YES is supported only in static analysis : ', i+is
2775  write(ilog,*) '### Error: MORTAR=YES is supported only in static analysis : ', i+is
2776  write(*,*) ' Specify !SOLUTION, TYPE=STATIC or TYPE=NLSTATIC.'
2777  write(ilog,*) ' Specify !SOLUTION, TYPE=STATIC or TYPE=NLSTATIC.'
2778  stop hecmw_exit_model
2779  endif
2780  ! Restart is not supported. The restart file keeps the node-level contact state
2781  ! only (contacts(i)%states over contacts(i)%slave), so the segment states in
2782  ! slave_surf and the converged multipliers are not saved. A resumed run would
2783  ! start with every segment free and without the warm start, and the initial scan
2784  ! is skipped on restart, so the difference would be silent.
2785  if( fstrsolid%restart_nout < 0 ) then
2786  write(*,*) '### Error: MORTAR=YES does not support restart : ', i+is
2787  write(ilog,*) '### Error: MORTAR=YES does not support restart : ', i+is
2788  write(*,*) ' The contact state of mortar pairs is not saved in the restart file.'
2789  write(ilog,*) ' The contact state of mortar pairs is not saved in the restart file.'
2790  stop hecmw_exit_model
2791  endif
2792  if( fstrparam%contact_algo == kcaslagrange ) then
2793  write(*,*) '### Error: MORTAR=YES is not supported with !CONTACT_ALGO TYPE=SLAGRANGE : ', i+is
2794  write(ilog,*) '### Error: MORTAR=YES is not supported with !CONTACT_ALGO TYPE=SLAGRANGE : ', i+is
2795  stop hecmw_exit_model
2796  endif
2797  if( fstrsolid%contacts(is+i)%surf_id1_sgrp <= 0 ) then
2798  write(*,*) '### Error: MORTAR=YES requires !CONTACT_PAIR TYPE=SURF-SURF : ', i+is
2799  write(ilog,*) '### Error: MORTAR=YES requires !CONTACT_PAIR TYPE=SURF-SURF : ', i+is
2800  stop hecmw_exit_model
2801  endif
2802  ! Only finite sliding is implemented. With any other INTERACTION the per-integration
2803  ! point tracking is skipped, and with it the activation of the slave segment, so the
2804  ! assembly sees every segment as free and no contact force is produced at all
2805  ! (a silent no-op). INTERACTION defaults to SSLID, so this must be an error.
2806  if( fstrsolid%contacts(is+i)%algtype /= contactfslid ) then
2807  write(*,*) '### Error: MORTAR=YES is supported only with INTERACTION=FSLID : ', i+is
2808  write(ilog,*) '### Error: MORTAR=YES is supported only with INTERACTION=FSLID : ', i+is
2809  write(*,*) ' Specify INTERACTION=FSLID on !CONTACT (the default is SSLID).'
2810  write(ilog,*) ' Specify INTERACTION=FSLID on !CONTACT (the default is SSLID).'
2811  stop hecmw_exit_model
2812  endif
2813  if( fstrsolid%contacts(is+i)%smoothing /= kcsnone ) then
2814  write(*,*) '### Error: MORTAR=YES is not supported with SMOOTHING= : ', i+is
2815  write(ilog,*) '### Error: MORTAR=YES is not supported with SMOOTHING= : ', i+is
2816  stop hecmw_exit_model
2817  endif
2818  ! Visibility guard: the mortar integral of a slave segment needs every master face
2819  ! it can project onto, so a rank owning slave faces must see the entire master
2820  ! surface (owned + ghost), which !PARTITION, CONTACT_OWNER=SLAVE provides. Verified
2821  ! by comparing the visible master count with the global owned-only count.
2822  ! Serial (np=1) skips the block, so the numerical path is unchanged.
2823  if( hecmw_comm_get_size() > 1 ) then
2824  ss_nslav = size( fstrsolid%contacts(is+i)%slave_surf )
2825  ss_nmas_vis = size( fstrsolid%contacts(is+i)%master )
2826  ss_nmas_glob = fstrsolid%contacts(is+i)%n_master_owned
2827  call hecmw_allreduce_i1( hecmesh, ss_nmas_glob, hecmw_sum )
2828  ! a slave-owning rank must see every master face; flag incomplete ghost
2829  if( ss_nslav > 0 .and. ss_nmas_vis /= ss_nmas_glob ) then
2830  ss_bad = 1
2831  else
2832  ss_bad = 0
2833  endif
2834  call hecmw_allreduce_i1( hecmesh, ss_bad, hecmw_max )
2835  if( ss_bad /= 0 ) then
2836  write(*,*) '### Error: MORTAR=YES contact pair has incomplete master ghost : ', i+is
2837  write(ilog,*) '### Error: MORTAR=YES contact pair has incomplete master ghost : ', i+is
2838  write(*,*) ' A rank owning slave faces cannot see the full master surface.'
2839  write(ilog,*) ' A rank owning slave faces cannot see the full master surface.'
2840  write(*,*) ' Re-partition the mesh with !PARTITION, CONTACT_OWNER=SLAVE,'
2841  write(ilog,*) ' Re-partition the mesh with !PARTITION, CONTACT_OWNER=SLAVE,'
2842  write(*,*) ' or run serial (np=1).'
2843  write(ilog,*) ' or run serial (np=1).'
2844  stop hecmw_exit_model
2845  endif
2846  endif
2847  endif
2848  enddo
2849 
2850  end subroutine fstr_solid_init_contacts
2851 
2852  !-----------------------------------------------------------------------------!
2854  !-----------------------------------------------------------------------------!
2857  subroutine fstr_solid_init_embeds( hecMESH, fstrSOLID, fstrPARAM, is, n, cparam_name, smoothing )
2858  implicit none
2859  type(hecmwst_local_mesh), pointer :: hecMESH
2860  type(fstr_solid) :: fstrSOLID
2861  type(fstr_param) :: fstrPARAM
2862  integer(kind=kint), intent(in) :: is
2863  integer(kind=kint), intent(in) :: n
2864  character(len=HECMW_NAME_LEN), intent(in) :: cparam_name
2865  integer(kind=kint), intent(in) :: smoothing
2866 
2867  integer(kind=kint) :: i, cparam_id
2868  logical :: isOK
2869 
2870  cparam_id = 0
2871  do i=1,size(fstrparam%contactparam)-1
2872  if( hecmw_streqr( fstrparam%contactparam(i)%name, cparam_name ) ) then
2873  cparam_id = i; exit
2874  endif
2875  enddo
2876  do i=1,n
2877  fstrsolid%embeds(is+i)%smoothing = smoothing
2878  if( .not. fstr_contact_check( fstrsolid%embeds(is+i), hecmesh ) ) then
2879  write(*,*) '### Error: Inconsistence in contact and surface definition : ' , i+is
2880  write(ilog,*) '### Error: Inconsistence in contact and surface definition : ', i+is
2881  stop hecmw_exit_model
2882  else
2883  isok = fstr_embed_init( fstrsolid%embeds(is+i), hecmesh, fstrparam%contactparam(cparam_id))
2884  endif
2885  enddo
2886 
2887  end subroutine fstr_solid_init_embeds
2888 
2889 end module m_fstr_solid_setup
fstr_ctrl_get_param_ex
int fstr_ctrl_get_param_ex(int *ctrl, const char *param_name, const char *value_list, int *necessity, char *type, void *val)
Definition: fstr_ctrl_util.c:1221
fstr_ctrl_get_c_h_name
int fstr_ctrl_get_c_h_name(int *ctrl, char *header_name, int *buff_size)
Definition: fstr_ctrl_util.c:1174
fstr_ctrl_util_f::fstr_ctrl_get_data_line_n
Definition: fstr_ctrl_util_f.f90:108
elementinfo
This module encapsulate the basic functions of all elements provide by this software.
Definition: element.f90:43
elementinfo::numofquadpoints
integer function numofquadpoints(fetype)
Obtains the number of quadrature points of the element.
Definition: element.f90:451
elementinfo::getspacedimension
integer(kind=kind(2)) function getspacedimension(etype)
Obtain the space dimension of the element.
Definition: element.f90:118
fstr_ctrl_common
This module contains fstr control file data obtaining functions.
Definition: fstr_ctrl_common.f90:7
fstr_ctrl_common::fstr_ctrl_get_element_activation
integer(kind=kint) function fstr_ctrl_get_element_activation(ctrl, amp, eps, grp_id_name, mode, measure, state, thlow, thup)
Read in !ELEMENT_ACTIVATION.
Definition: fstr_ctrl_common.f90:1245
fstr_ctrl_common::fstr_ctrl_get_couple
integer(kind=kint) function fstr_ctrl_get_couple(ctrl, fg_type, fg_first, fg_window, surf_id, surf_id_len)
Read in !COUPLE.
Definition: fstr_ctrl_common.f90:509
fstr_ctrl_common::fstr_ctrl_get_contact
logical function fstr_ctrl_get_contact(ctrl, n, contact, np, tp, ntol, ttol, cpname, smoothing)
Read in contact definition.
Definition: fstr_ctrl_common.f90:650
fstr_ctrl_common::fstr_ctrl_get_outitem
logical function fstr_ctrl_get_outitem(ctrl, hecMESH, outinfo)
Read in !OUTPUT_RES & !OUTPUT_VIS.
Definition: fstr_ctrl_common.f90:549
fstr_ctrl_common::fstr_ctrl_get_elemopt
integer(kind=kint) function fstr_ctrl_get_elemopt(ctrl, elemopt361)
Read in !ELEMOPT.
Definition: fstr_ctrl_common.f90:937
fstr_ctrl_common::fstr_ctrl_get_istep
logical function fstr_ctrl_get_istep(ctrl, hecMESH, steps, tpname, apname, cpname)
Read in !STEP and !ISTEP.
Definition: fstr_ctrl_common.f90:292
fstr_ctrl_common::fstr_ctrl_get_section
integer function fstr_ctrl_get_section(ctrl, hecMESH, sections)
Read in !SECTION.
Definition: fstr_ctrl_common.f90:417
fstr_ctrl_common::fstr_ctrl_get_step
integer(kind=kint) function fstr_ctrl_get_step(ctrl, amp, iproc)
Read in !STEP.
Definition: fstr_ctrl_common.f90:270
fstr_ctrl_common::fstr_ctrl_get_embed
logical function fstr_ctrl_get_embed(ctrl, n, embed, cpname, smoothing)
Read in contact definition.
Definition: fstr_ctrl_common.f90:761
fstr_ctrl_dynamic
This module contains control file data obtaining functions for dynamic analysis.
Definition: fstr_ctrl_dynamic.f90:7
fstr_ctrl_dynamic::fstr_ctrl_get_velocity
integer(kind=kint) function fstr_ctrl_get_velocity(ctrl, vType, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !VELOCITY.
Definition: fstr_ctrl_dynamic.f90:48
fstr_ctrl_dynamic::fstr_ctrl_get_acceleration
integer(kind=kint) function fstr_ctrl_get_acceleration(ctrl, aType, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !ACCELERATION.
Definition: fstr_ctrl_dynamic.f90:66
fstr_ctrl_material
This module manages read in of various material properties.
Definition: fstr_ctrl_material.f90:6
fstr_ctrl_material::fstr_ctrl_get_dashpot_d
integer function fstr_ctrl_get_dashpot_d(ctrl, mattype, nlgeom, matval_i, dict)
Read in !DASHPOT_D.
Definition: fstr_ctrl_material.f90:1209
fstr_ctrl_material::fstr_ctrl_get_hyperelastic
integer function fstr_ctrl_get_hyperelastic(ctrl, mattype, nlgeom, matval)
Read in !HYPERELASTIC.
Definition: fstr_ctrl_material.f90:224
fstr_ctrl_material::fstr_ctrl_get_viscoelasticity
integer function fstr_ctrl_get_viscoelasticity(ctrl, mattype, nlgeom, dict)
Read in !VISCOELASTIC.
Definition: fstr_ctrl_material.f90:383
fstr_ctrl_material::fstr_ctrl_get_viscoplasticity
integer function fstr_ctrl_get_viscoplasticity(ctrl, mattype, nlgeom, dict)
Read in !CREEP.
Definition: fstr_ctrl_material.f90:729
fstr_ctrl_material::fstr_ctrl_get_usermaterial
integer function fstr_ctrl_get_usermaterial(ctrl, mattype, nlgeom, nstatus, matval)
Read in !USER_MATERIAL.
Definition: fstr_ctrl_material.f90:31
fstr_ctrl_material::fstr_ctrl_get_expansion_coeff
integer function fstr_ctrl_get_expansion_coeff(ctrl, matval, dict)
Read in !EXPANSION_COEFF.
Definition: fstr_ctrl_material.f90:845
fstr_ctrl_material::fstr_ctrl_get_trs
integer function fstr_ctrl_get_trs(ctrl, mattype, matval)
Read in !TRS.
Definition: fstr_ctrl_material.f90:466
fstr_ctrl_material::fstr_ctrl_get_elasticity
integer function fstr_ctrl_get_elasticity(ctrl, mattype, nlgeom, matval, dict)
Read in !ELASTIC.
Definition: fstr_ctrl_material.f90:53
fstr_ctrl_material::fstr_ctrl_get_dashpot_a
integer function fstr_ctrl_get_dashpot_a(ctrl, mattype, nlgeom, matval_i, dict)
Read in !DASHPOT_A.
Definition: fstr_ctrl_material.f90:1269
fstr_ctrl_material::fstr_ctrl_get_material
integer function fstr_ctrl_get_material(ctrl, matname)
Read in !MATERIAL.
Definition: fstr_ctrl_material.f90:21
fstr_ctrl_material::fstr_ctrl_get_density
integer function fstr_ctrl_get_density(ctrl, matval)
Read in !DENSITY.
Definition: fstr_ctrl_material.f90:808
fstr_ctrl_material::fstr_ctrl_get_spring_a
integer function fstr_ctrl_get_spring_a(ctrl, mattype, nlgeom, matval_i, dict)
Read in !SPRING_A.
Definition: fstr_ctrl_material.f90:1159
fstr_ctrl_material::fstr_ctrl_get_rayleigh_damping
integer function fstr_ctrl_get_rayleigh_damping(ctrl, matval, is_RD)
Read in !DAMPING (element-wise Rayleigh damping)
Definition: fstr_ctrl_material.f90:953
fstr_ctrl_material::fstr_ctrl_get_fluid
integer function fstr_ctrl_get_fluid(ctrl, mattype, nlgeom, matval, dict)
Read in !FLUID.
Definition: fstr_ctrl_material.f90:1029
fstr_ctrl_material::fstr_ctrl_get_spring_d
integer function fstr_ctrl_get_spring_d(ctrl, mattype, nlgeom, matval_i, dict)
Read in !SPRING_D.
Definition: fstr_ctrl_material.f90:1099
fstr_ctrl_material::fstr_ctrl_get_plasticity
integer function fstr_ctrl_get_plasticity(ctrl, mattype, nlgeom, matval, dict)
Read in !PLASTIC.
Definition: fstr_ctrl_material.f90:488
fstr_ctrl_static
This module contains control file data obtaining functions for static analysis.
Definition: fstr_ctrl_static.f90:6
fstr_ctrl_static::fstr_ctrl_get_static
integer(kind=kint) function fstr_ctrl_get_static(ctrl, dtime, etime, itime, eps, restart_nout, idx_elpl, iout_list, sig_y0, h_dash, nout, nout_monit, node_monit_1, elem_monit_1, intg_monit_1)
Read in !STATIC.
Definition: fstr_ctrl_static.f90:23
fstr_ctrl_static::fstr_ctrl_get_boundary
integer(kind=kint) function fstr_ctrl_get_boundary(ctrl, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !BOUNDARY.
Definition: fstr_ctrl_static.f90:54
fstr_ctrl_static::fstr_ctrl_get_spring
integer(kind=kint) function fstr_ctrl_get_spring(ctrl, amp, node_id, node_id_len, dof_id, value, incremental)
Read in !SPRING.
Definition: fstr_ctrl_static.f90:255
fstr_ctrl_static::fstr_ctrl_get_dload
integer(kind=kint) function fstr_ctrl_get_dload(ctrl, amp, follow, element_id, element_id_len, load_type, params)
Read in !DLOAD.
Definition: fstr_ctrl_static.f90:106
fstr_ctrl_static::fstr_ctrl_get_temperature
integer(kind=kint) function fstr_ctrl_get_temperature(ctrl, irres, tstep, tintl, rtype, node_id, node_id_len, value)
Read in !TEMPERATURE.
Definition: fstr_ctrl_static.f90:218
fstr_ctrl_static::fstr_ctrl_get_cload
integer(kind=kint) function fstr_ctrl_get_cload(ctrl, amp, node_id, node_id_len, dof_id, value)
Read in !CLOAD.
Definition: fstr_ctrl_static.f90:81
fstr_ctrl_static::fstr_ctrl_get_userload
integer function fstr_ctrl_get_userload(ctrl)
Read in !ULOAD.
Definition: fstr_ctrl_static.f90:282
fstr_ctrl_util_f
Definition: fstr_ctrl_util_f.f90:1
fstr_setup_util
This module contains auxiliary functions in calculation setup.
Definition: fstr_setup_util.f90:7
fstr_setup_util::fstr_ctrl_err_stop
subroutine fstr_ctrl_err_stop
Definition: fstr_setup_util.f90:79
fstr_setup_util::dload_grp_name_to_id_ex
subroutine dload_grp_name_to_id_ex(hecMESH, n, grp_id_name, fg_surface, grp_ID)
Definition: fstr_setup_util.f90:477
fstr_setup_util::amp_name_to_id
subroutine amp_name_to_id(hecMESH, header_name, aname, id)
Definition: fstr_setup_util.f90:626
fstr_setup_util::fstr_setup_util_err_stop
subroutine fstr_setup_util_err_stop(msg)
Definition: fstr_setup_util.f90:91
hecmw_setup_util
This module contains auxiliary functions in calculation setup.
Definition: hecmw_setup_util_f.f90:7
hecmw_setup_util::hecmw_expand_integer_array
subroutine hecmw_expand_integer_array(array, old_size, new_size)
Definition: hecmw_setup_util_f.f90:726
hecmw_setup_util::node_grp_name_to_id_ex
subroutine node_grp_name_to_id_ex(hecMESH, header_name, n, grp_id_name, grp_ID)
Definition: hecmw_setup_util_f.f90:509
hecmw_setup_util::hecmw_expand_real_array
subroutine hecmw_expand_real_array(array, old_size, new_size)
Definition: hecmw_setup_util_f.f90:754
hecmw_setup_util::surf_grp_name_to_id_ex
subroutine surf_grp_name_to_id_ex(hecMESH, header_name, n, grp_id_name, grp_ID)
Definition: hecmw_setup_util_f.f90:619
hecmw_setup_util::hecmw_streqr
logical function hecmw_streqr(s1, s2)
Definition: hecmw_setup_util_f.f90:68
hecmw_setup_util::elem_grp_name_to_id_ex
subroutine elem_grp_name_to_id_ex(hecMESH, header_name, n, grp_id_name, grp_ID)
Definition: hecmw_setup_util_f.f90:563
m_fstr_finiterotationkinematics
Shared finite-rotation nodal kinematics and rotation algebra.
Definition: fstr_FiniteRotationKinematics.f90:7
m_fstr_finiterotationkinematics::fstr_has_finite_rotation_kinematics
logical function, public fstr_has_finite_rotation_kinematics(hecMESH, fstrSOLID)
Definition: fstr_FiniteRotationKinematics.f90:52
m_fstr_finiterotationkinematics::fstr_uses_finite_rotation_kinematics
logical function, public fstr_uses_finite_rotation_kinematics(etype, nn, material)
Definition: fstr_FiniteRotationKinematics.f90:42
m_fstr_finiterotationkinematics::fstr_mark_finite_rotation_nodes
subroutine, public fstr_mark_finite_rotation_nodes(hecMESH, fstrSOLID, ndof, shell_node_mode)
Definition: fstr_FiniteRotationKinematics.f90:87
m_fstr_solid_setup
This module provides subroutines to initialize, allocate and finalize fstr_solid, and to read the car...
Definition: fstr_solid_setup.f90:11
m_fstr_solid_setup::fstr_solid_init_embeds
subroutine fstr_solid_init_embeds(hecMESH, fstrSOLID, fstrPARAM, is, n, cparam_name, smoothing)
Initialize !EMBED !
Definition: fstr_solid_setup.f90:2858
m_fstr_solid_setup::fstr_setup_dashpot_a
subroutine fstr_setup_dashpot_a(ctrl, P)
Read in !DASHPOT_A !
Definition: fstr_solid_setup.f90:2095
m_fstr_solid_setup::fstr_setup_step_convergence
subroutine fstr_setup_step_convergence(stepinfo, cpname, cnvparam, istep)
Fix the convergence criteria of a step from !STEP and the !CONVERG_PARAM it refers to.
Definition: fstr_solid_setup.f90:938
m_fstr_solid_setup::fstr_setup_plastic
subroutine fstr_setup_plastic(ctrl, P)
Read in !PLASTIC !
Definition: fstr_solid_setup.f90:1806
m_fstr_solid_setup::fstr_setup_material
subroutine fstr_setup_material(ctrl, P)
Read in !MATERIAL !
Definition: fstr_solid_setup.f90:1712
m_fstr_solid_setup::fstr_solid_init
subroutine fstr_solid_init(hecMESH, fstrSOLID)
Initializer of structure fstr_solid.
Definition: fstr_solid_setup.f90:38
m_fstr_solid_setup::fstr_element_init
subroutine fstr_element_init(hecMESH, fstrSOLID, solution_type)
Initialize elements info in static calculation.
Definition: fstr_solid_setup.f90:321
m_fstr_solid_setup::fstr_expand_dload_array
subroutine fstr_expand_dload_array(array, old_size, new_size)
Reset !DLOAD !
Definition: fstr_solid_setup.f90:2366
m_fstr_solid_setup::fstr_solid_append_element_activation
subroutine fstr_solid_append_element_activation(hecMESH, fstrSOLID, header_name, gid, amp_name, eps, measure, state, n, grp_names, thlow, thup)
Append !ELEMENT_ACTIVATION !
Definition: fstr_solid_setup.f90:2678
m_fstr_solid_setup::fstr_setup_trs
subroutine fstr_setup_trs(ctrl, P)
Read in !TRS !
Definition: fstr_solid_setup.f90:1879
m_fstr_solid_setup::fstr_setup_spring_d
subroutine fstr_setup_spring_d(ctrl, P)
Read in !SPRING_D !
Definition: fstr_solid_setup.f90:2020
m_fstr_solid_setup::fstr_setup_solid_nastran
subroutine fstr_setup_solid_nastran(ctrl, hecMESH, fstrSOLID)
Definition: fstr_solid_setup.f90:1522
m_fstr_solid_setup::fstr_setup_acceleration
subroutine fstr_setup_acceleration(ctrl, P)
Read in !ACCELERATION !
Definition: fstr_solid_setup.f90:1477
m_fstr_solid_setup::fstr_setup_elemopt
subroutine fstr_setup_elemopt(ctrl, P)
Read in !ELEMOPT !
Definition: fstr_solid_setup.f90:1690
m_fstr_solid_setup::fstr_setup_output_vis
subroutine fstr_setup_output_vis(ctrl, P)
Read in !OUTPUT_VIS !
Definition: fstr_solid_setup.f90:2174
m_fstr_solid_setup::fstr_setup_output_res
subroutine fstr_setup_output_res(ctrl, P)
Read in !OUTPUT_RES !
Definition: fstr_solid_setup.f90:2143
m_fstr_solid_setup::fstr_setup_step_store
subroutine fstr_setup_step_store(ctrl, P)
Read in !STEP !
Definition: fstr_solid_setup.f90:1638
m_fstr_solid_setup::fstr_solid_append_spring
subroutine fstr_solid_append_spring(hecMESH, fstrSOLID, header_name, gid, incremental, amp_name, n, grp_names, dofs, vals)
Append !SPRING !
Definition: fstr_solid_setup.f90:2479
m_fstr_solid_setup::fstr_setup_creep
subroutine fstr_setup_creep(ctrl, P)
Read in !CREEP !
Definition: fstr_solid_setup.f90:1906
m_fstr_solid_setup::fstr_solid_append_dload
subroutine fstr_solid_append_dload(hecMESH, fstrSOLID, header_name, gid, follow, amp_name, n, grp_names, lids, params)
Append !DLOAD !
Definition: fstr_solid_setup.f90:2399
m_fstr_solid_setup::fstr_solid_finalize
subroutine fstr_solid_finalize(fstrSOLID)
Finalizer of fstr_solid.
Definition: fstr_solid_setup.f90:453
m_fstr_solid_setup::fstr_setup_current_material
integer(kind=kint) function fstr_setup_current_material(ctrl, P)
Material of the last !MATERIAL, for a material card. Stops at a material card given before the first ...
Definition: fstr_solid_setup.f90:1762
m_fstr_solid_setup::fstr_setup_boundary
subroutine fstr_setup_boundary(ctrl, P)
Read in !BOUNDARY !
Definition: fstr_solid_setup.f90:1180
m_fstr_solid_setup::fstr_setup_damping
subroutine fstr_setup_damping(ctrl, P)
Read in !DAMPING !
Definition: fstr_solid_setup.f90:1973
m_fstr_solid_setup::fstr_solid_alloc
subroutine fstr_solid_alloc(hecMESH, fstrSOLID)
Initializer of structure fstr_solid.
Definition: fstr_solid_setup.f90:77
m_fstr_solid_setup::fstr_setup_expansion_coeff
subroutine fstr_setup_expansion_coeff(ctrl, P)
Read in !EXPANSION_COEF !
Definition: fstr_solid_setup.f90:1951
m_fstr_solid_setup::fstr_setup_viscoelastic
subroutine fstr_setup_viscoelastic(ctrl, P)
Read in !VISCOELASTIC !
Definition: fstr_solid_setup.f90:1855
m_fstr_solid_setup::fstr_setup_density
subroutine fstr_setup_density(ctrl, P)
Read in !DENSITY !
Definition: fstr_solid_setup.f90:1930
m_fstr_solid_setup::fstr_solid_init_contacts
subroutine fstr_solid_init_contacts(hecMESH, fstrSOLID, fstrPARAM, is, n, cparam_name, smoothing)
Initialize !CONTACT !
Definition: fstr_solid_setup.f90:2730
m_fstr_solid_setup::fstr_setup_fluid
subroutine fstr_setup_fluid(ctrl, P)
Read in !FLUID !
Definition: fstr_solid_setup.f90:1995
m_fstr_solid_setup::fstr_setup_step
subroutine fstr_setup_step(ctrl, P)
Read in !STEP !
Definition: fstr_solid_setup.f90:920
m_fstr_solid_setup::fstr_setup_step_links
subroutine fstr_setup_step_links(fstrPARAM, fstrSOLID, fstrDYNAMIC, istep, tp_name, ainc_name, cnv_name)
Links step_ctrl(istep), whose step is already read, to !TIME_POINTS, !AUTOINC_PARAM and !...
Definition: fstr_solid_setup.f90:973
m_fstr_solid_setup::fstr_solid_append_acceleration
subroutine fstr_solid_append_acceleration(hecMESH, fstrSOLID, fstrDYNAMIC, header_name, gid, atype, amp_name, n, grp_names, dof_ids, dof_ide, vals)
Append !ACCELERATION !
Definition: fstr_solid_setup.f90:2596
m_fstr_solid_setup::fstr_setup_section
subroutine fstr_setup_section(ctrl, P)
Read in !SECTION !
Definition: fstr_solid_setup.f90:1667
m_fstr_solid_setup::fstr_solid_append_velocity
subroutine fstr_solid_append_velocity(hecMESH, fstrSOLID, fstrDYNAMIC, header_name, gid, vtype, rotc_name, amp_name, n, grp_names, dof_ids, dof_ide, vals)
Append !VELOCITY !
Definition: fstr_solid_setup.f90:2524
m_fstr_solid_setup::fstr_setup_istep
subroutine fstr_setup_istep(ctrl, P)
Read in !ISTEP !
Definition: fstr_solid_setup.f90:1595
m_fstr_solid_setup::fstr_smoothed_element_init
subroutine fstr_smoothed_element_init(hecMESH, fstrSOLID)
Definition: fstr_solid_setup.f90:270
m_fstr_solid_setup::fstr_setup_user_material
subroutine fstr_setup_user_material(ctrl, P)
Read in !USER_MATERIAL !
Definition: fstr_solid_setup.f90:2120
m_fstr_solid_setup::fstr_setup_dload
subroutine fstr_setup_dload(ctrl, P)
Read in !DLOAD.
Definition: fstr_solid_setup.f90:1287
m_fstr_solid_setup::fstr_setup_cload
subroutine fstr_setup_cload(ctrl, P)
Read in !CLOAD !
Definition: fstr_solid_setup.f90:1240
m_fstr_solid_setup::fstr_setup_spring_a
subroutine fstr_setup_spring_a(ctrl, P)
Read in !SPRING_A !
Definition: fstr_solid_setup.f90:2045
m_fstr_solid_setup::fstr_setup_write_store
subroutine fstr_setup_write_store(ctrl, P)
Read in !WRITE after fstr_setup_prepare and store the output controls. fg_result and fg_visual are se...
Definition: fstr_solid_setup.f90:1027
m_fstr_solid_setup::fstr_setup_spring
subroutine fstr_setup_spring(ctrl, P)
Read in !SPRING !
Definition: fstr_solid_setup.f90:1377
m_fstr_solid_setup::fstr_setup_contact
subroutine fstr_setup_contact(ctrl, P)
Read in !CONTACT !
Definition: fstr_solid_setup.f90:1534
m_fstr_solid_setup::fstr_setup_dashpot_d
subroutine fstr_setup_dashpot_d(ctrl, P)
Read in !DASHPOT_D !
Definition: fstr_solid_setup.f90:2070
m_fstr_solid_setup::fstr_solid_append_temperature
subroutine fstr_solid_append_temperature(hecMESH, fstrSOLID, header_name, gid, n, grp_names, vals)
Append !TEMPERATURE !
Definition: fstr_solid_setup.f90:2447
m_fstr_solid_setup::fstr_setup_embed
subroutine fstr_setup_embed(ctrl, P)
Read in !EMBED !
Definition: fstr_solid_setup.f90:1567
m_fstr_solid_setup::fstr_solid_append_couple
subroutine fstr_solid_append_couple(hecMESH, fstrSOLID, fstrPARAM, header_name, n, grp_names)
Append !COUPLE !
Definition: fstr_solid_setup.f90:2649
m_fstr_solid_setup::fstr_setup_static
subroutine fstr_setup_static(ctrl, P)
Read in !STATIC(old) !
Definition: fstr_solid_setup.f90:1135
m_fstr_solid_setup::fstr_solid_append_boundary
subroutine fstr_solid_append_boundary(hecMESH, fstrSOLID, header_name, gid, istot, rotc_name, amp_name, n, grp_names, dof_ids, dof_ide, vals)
Append !BOUNDARY !
Definition: fstr_solid_setup.f90:2222
m_fstr_solid_setup::fstr_setup_write_flags
subroutine fstr_setup_write_flags(ctrl, P)
Read in !WRITE before fstr_setup_prepare and set fg_result and fg_visual.
Definition: fstr_solid_setup.f90:1012
m_fstr_solid_setup::fstr_smoothed_element_calcmaxcon
subroutine fstr_smoothed_element_calcmaxcon(hecMESH, fstrSOLID)
Definition: fstr_solid_setup.f90:301
m_fstr_solid_setup::fstr_solid_physic_val_finalize
recursive subroutine fstr_solid_physic_val_finalize(phys)
Definition: fstr_solid_setup.f90:410
m_fstr_solid_setup::fstr_solid_append_cload
subroutine fstr_solid_append_cload(hecMESH, fstrSOLID, header_name, gid, rotc_name, amp_name, n, grp_names, dofs, vals)
Append !CLOAD !
Definition: fstr_solid_setup.f90:2291
m_fstr_solid_setup::fstr_setup_element_activation
subroutine fstr_setup_element_activation(ctrl, P)
Read in !ELEMENT_ACTIVATION.
Definition: fstr_solid_setup.f90:1100
m_fstr_solid_setup::fstr_setup_temperature
subroutine fstr_setup_temperature(ctrl, P)
Read in !TEMPERATURE !
Definition: fstr_solid_setup.f90:1334
m_fstr_solid_setup::fstr_setup_velocity
subroutine fstr_setup_velocity(ctrl, P)
Read in !VELOCITY !
Definition: fstr_solid_setup.f90:1421
m_fstr_solid_setup::fstr_setup_uload
subroutine fstr_setup_uload(ctrl, P)
Read in !ULOAD !
Definition: fstr_solid_setup.f90:2205
m_fstr_solid_setup::fstr_setup_couple
subroutine fstr_setup_couple(ctrl, P)
Read in !COUPLE !
Definition: fstr_solid_setup.f90:1072
m_fstr_solid_setup::fstr_setup_elastic
subroutine fstr_setup_elastic(ctrl, P)
Read in !ELASTIC !
Definition: fstr_solid_setup.f90:1781
m_fstr_solid_setup::fstr_setup_hyperelastic
subroutine fstr_setup_hyperelastic(ctrl, P)
Read in !HYPERELASTIC !
Definition: fstr_solid_setup.f90:1831
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.F90:15
m_fstr::iutb
integer(kind=kint), parameter iutb
Definition: m_fstr.F90:120
m_fstr::myrank
integer(kind=kint) myrank
PARALLEL EXECUTION.
Definition: m_fstr.F90:107
m_fstr::kel341sesns
integer(kind=kint), parameter kel341sesns
Definition: m_fstr.F90:82
m_fstr::kbcffstr
integer(kind=kint), parameter kbcffstr
boundary condition file type (bcf)
Definition: m_fstr.F90:66
m_fstr::kstdynamic
integer(kind=kint), parameter kstdynamic
Definition: m_fstr.F90:41
m_fstr::idbg
integer(kind=kint), parameter idbg
Definition: m_fstr.F90:122
m_fstr::kel361ic
integer(kind=kint), parameter kel361ic
Definition: m_fstr.F90:86
m_fstr::fstr_abort
subroutine fstr_abort(code)
Terminate the analysis with a classified exit status. MPI_ABORT does not perform the Fortran I/O fina...
Definition: m_fstr.F90:692
m_fstr::kcaslagrange
integer(kind=kint), parameter kcaslagrange
contact analysis algorithm
Definition: m_fstr.F90:62
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.F90:118
m_fstr::kststatic
integer(kind=kint), parameter kststatic
Definition: m_fstr.F90:38
m_fstr::kbcinitial
integer(kind=kint), parameter kbcinitial
Definition: m_fstr.F90:69
m_fstr::kstprecheck
integer(kind=kint), parameter kstprecheck
solution type (st)
Definition: m_fstr.F90:37
m_fstr::kstheat
integer(kind=kint), parameter kstheat
Definition: m_fstr.F90:40
m_fstr::kstnzprof
integer(kind=kint), parameter kstnzprof
Definition: m_fstr.F90:44
m_fstr::kbctransit
integer(kind=kint), parameter kbctransit
Definition: m_fstr.F90:70
m_static_lib_c3d4sesns
This module contains several strategy to free locking problem in Eight-node hexagonal element.
Definition: static_LIB_C3D4_selectiveESNS.f90:7
m_static_lib_c3d4sesns::return_nn_comp_c3d4_sesns
integer(kind=kint) function, public return_nn_comp_c3d4_sesns(nn, nodlocal)
Definition: static_LIB_C3D4_selectiveESNS.f90:69
mmaterial
This module summarizes all information of material properties.
Definition: material.f90:6
mmaterial::viscoelastic
integer(kind=kint), parameter viscoelastic
Definition: material.f90:80
mmaterial::initmaterial
subroutine initmaterial(material)
Initializer.
Definition: material.f90:191
mmechgauss
This modules defines a structure to record history dependent parameter in static analysis.
Definition: mechgauss.f90:6
mmechgauss::fstr_shell_num_thickness_points
integer(kind=kint) function fstr_shell_num_thickness_points(etype)
Compatibility accessor for shell history allocation. The quadrature rule itself is defined in element...
Definition: mechgauss.f90:144
mmechgauss::fstr_init_gauss
subroutine fstr_init_gauss(gauss)
Initializer.
Definition: mechgauss.f90:89
mmechgauss::fstr_init_shell_layer_gausses
subroutine fstr_init_shell_layer_gausses(element, ng, nlayer, nthick)
Allocate shell history for every surface Gauss point, layer, and thickness point.
Definition: mechgauss.f90:151
mmechgauss::fstr_finalize_shell_layer_gausses
subroutine fstr_finalize_shell_layer_gausses(element)
Release shell layer/thickness history.
Definition: mechgauss.f90:316
mmechgauss::fstr_uses_plane_stress_j2_shell
logical function fstr_uses_plane_stress_j2_shell(etype, nn, material)
Return whether the element and material are supported by the plane-stress J2 shell path.
Definition: mechgauss.f90:72
fstr_setup_util::fstr_card_slot
Places of a card in its sequence, from first to last. A card counted one by one has one place (first ...
Definition: fstr_setup_util.f90:15
fstr_setup_util::fstr_param_pack
Package of all data needs to initialize.
Definition: fstr_setup_util.f90:29
m_fstr::fstr_dynamic
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.F90:525
m_fstr::fstr_param
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.F90:142
m_fstr::fstr_solid_physic_val
Data for STATIC ANSLYSIS (fstrSOLID)
Definition: m_fstr.F90:203
m_fstr::fstr_solid
Definition: m_fstr.F90:230