FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
fstr_ctrl_static.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 !-------------------------------------------------------------------------------
6 module fstr_ctrl_static
7  use m_fstr
8  use hecmw
9  include 'fstr_ctrl_util_f.inc'
10 
11  private :: pc_strupr
12 contains
13 
14  subroutine pc_strupr( s )
15  implicit none
16  character(*) :: s
17  integer :: i, n, a, da
18 
19  n = len_trim(s)
20  da = iachar('a') - iachar('A')
21  do i = 1, n
22  a = iachar(s(i:i))
23  if( a > iachar('Z')) then
24  a = a - da
25  s(i:i) = achar(a)
26  end if
27  end do
28  end subroutine pc_strupr
29 
30  !* ----------------------------------------------------------------------------------------------- *!
32  !* ----------------------------------------------------------------------------------------------- *!
33 
34  function fstr_ctrl_get_static( ctrl, &
35  & dtime, etime, itime, eps, restart_nout, &
36  & idx_elpl, &
37  & iout_list, &
38  & sig_y0, h_dash, &
39  & nout, nout_monit, node_monit_1, elem_monit_1, intg_monit_1 )
40  implicit none
41  integer(kind=kint) :: ctrl
42  real(kind=kreal) :: dtime
43  real(kind=kreal) :: etime
44  integer(kind=kint) :: itime
45  real(kind=kreal) :: eps
46  integer(kind=kint) :: restart_nout
47  integer(kind=kint) :: idx_elpl
48  real(kind=kreal) :: sig_y0, h_dash
49  integer(kind=kint) :: nout, nout_monit, node_monit_1, elem_monit_1, intg_monit_1
50  integer(kind=kint) :: iout_list(6)
51  integer(kind=kint) :: fstr_ctrl_get_static
52 
53  fstr_ctrl_get_static = -1
54 
55  if( fstr_ctrl_get_data_ex( ctrl, 1, 'rriri ', dtime, etime, itime, eps, restart_nout ) /= 0 ) return
56  if( fstr_ctrl_get_data_ex( ctrl, 2, 'i ', idx_elpl ) /= 0 ) return
57  if( fstr_ctrl_get_data_ex( ctrl, 3, 'iiiiii ', &
58  & iout_list(1), iout_list(2), iout_list(3), iout_list(4), iout_list(5), iout_list(6)) /= 0 ) return
59  if( fstr_ctrl_get_data_ex( ctrl, 4, 'rr ', sig_y0, h_dash ) /= 0 ) return
60  if( fstr_ctrl_get_data_ex( ctrl, 5, 'iiiii ', &
61  & nout, nout_monit, node_monit_1, elem_monit_1, intg_monit_1 ) /= 0 ) return
62 
63  fstr_ctrl_get_static = 0
64  end function fstr_ctrl_get_static
65 
66  !* ----------------------------------------------------------------------------------------------- *!
68  !* ----------------------------------------------------------------------------------------------- *!
69 
70  function fstr_ctrl_get_boundary( ctrl, amp, node_id, node_id_len, dof_ids, dof_ide, value )
71  implicit none
72  integer(kind=kint) :: ctrl
73  character(len=HECMW_NAME_LEN) :: amp
74  character(len=HECMW_NAME_LEN),target :: node_id(:)
75  character(len=HECMW_NAME_LEN),pointer :: node_id_p
76  integer(kind=kint) :: node_id_len
77  integer(kind=kint),pointer :: dof_ids (:)
78  integer(kind=kint),pointer :: dof_ide (:)
79  real(kind=kreal),pointer :: value(:)
80  integer(kind=kint) :: fstr_ctrl_get_boundary
81 
82  character(len=HECMW_NAME_LEN) :: data_fmt,ss
83  write(ss,*) node_id_len
84  write(data_fmt,'(a,a,a)') 'S',trim(adjustl(ss)),'IIr '
85 
86  fstr_ctrl_get_boundary = -1
87  if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
88  node_id_p => node_id(1)
89  fstr_ctrl_get_boundary = &
90  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, node_id_p, dof_ids, dof_ide, value )
91 
92  end function fstr_ctrl_get_boundary
93 
94 
95  !* ----------------------------------------------------------------------------------------------- *!
97  !* ----------------------------------------------------------------------------------------------- *!
98 
99  function fstr_ctrl_get_cload( ctrl, amp, node_id, node_id_len, dof_id, value )
100  implicit none
101  integer(kind=kint) :: ctrl
102  character(len=HECMW_NAME_LEN) :: amp
103  character(len=HECMW_NAME_LEN),target :: node_id(:)
104  character(len=HECMW_NAME_LEN),pointer :: node_id_p
105  integer(kind=kint) :: node_id_len
106  integer(kind=kint),pointer :: dof_id(:)
107  real(kind=kreal),pointer :: value(:)
108  integer(kind=kint) :: fstr_ctrl_get_cload
109 
110  character(len=HECMW_NAME_LEN) :: data_fmt,ss
111  write(ss,*) node_id_len
112  write( data_fmt, '(a,a,a)') 'S', trim(adjustl(ss)), 'IR '
113 
114  fstr_ctrl_get_cload = -1
115  if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
116  node_id_p => node_id(1)
117  fstr_ctrl_get_cload = &
118  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, node_id_p, dof_id, value )
119 
120  end function fstr_ctrl_get_cload
121 
122  !* ----------------------------------------------------------------------------------------------- *!
124  !* ----------------------------------------------------------------------------------------------- *!
125 
126  function fstr_ctrl_get_dload( ctrl, amp, follow, element_id, element_id_len, load_type, params )
127  implicit none
128  integer(kind=kint) :: ctrl
129  character(len=HECMW_NAME_LEN) :: amp
130  integer(kind=kint) :: follow
131  character(len=HECMW_NAME_LEN),target :: element_id(:)
132  integer(kind=kint) :: element_id_len
133  integer(kind=kint),pointer :: load_type(:)
134  real(kind=kreal),pointer :: params(:,:)
135  integer(kind=kint) :: fstr_ctrl_get_dload
136 
137  character(len=HECMW_NAME_LEN),pointer :: type_name_list(:)
138  character(len=HECMW_NAME_LEN),pointer :: type_name_list_p
139  character(len=HECMW_NAME_LEN),pointer :: element_id_p
140 
141  integer(kind=kint) :: i, n
142  integer(kind=kint) :: rcode
143  character(len=HECMW_NAME_LEN) :: data_fmt,s1,s2
144  integer(kind=kint) :: lid
145 
146  fstr_ctrl_get_dload = -1
147  if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
148  follow = follow+1
149  if( fstr_ctrl_get_param_ex( ctrl, 'FOLLOW ','NO,YES ', 0, 'P', follow ) /= 0) return
150  follow = follow-1
151 
152  write(s1,*) element_id_len
153  write(s2,*) hecmw_name_len
154  write( data_fmt, '(a,a,a,a,a)') 'S', trim(adjustl(s1)), 'S', trim(adjustl(s2)),'Rrrrrrr '
155 
156  n = fstr_ctrl_get_data_line_n(ctrl)
157  allocate( type_name_list(n) )
158  !!
159  !! for avoiding stack overflow with intel 9 compiler
160  !!
161  element_id_p => element_id(1)
162  type_name_list_p => type_name_list(1)
163 
164  rcode = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, element_id_p, type_name_list_p, &
165  params(0,:), params(1,:), params(2,:), params(3,:), params(4,:),params(5,:), &
166  params(6,:) )
167 
168  if( rcode /= 0 ) then
169  deallocate( type_name_list )
170  return
171  end if
172 
173  do i=1, n
174  call pc_strupr( type_name_list(i) )
175  lid = -1;
176  if( type_name_list(i)(1:2) == 'BX' ) then; lid = 1
177  else if( type_name_list(i)(1:2) == 'BY' ) then; lid = 2
178  else if( type_name_list(i)(1:2) == 'BZ' ) then; lid = 3
179  else if( type_name_list(i)(1:4) == 'GRAV') then; lid = 4
180  else if( type_name_list(i)(1:4) == 'CENT') then; lid = 5
181  else if( type_name_list(i)(1:2) == 'PP' ) then; lid = 10
182  else if( type_name_list(i)(1:2) == 'P0' ) then; lid = 10
183  else if( type_name_list(i)(1:2) == 'PX' ) then
184  lid = 10; params(1,:)=1.d0; params(2,:)=0.d0; params(3,:)=0.d0
185  else if( type_name_list(i)(1:2) == 'PY' ) then
186  lid = 10; params(1,:)=0.d0; params(2,:)=1.d0; params(3,:)=0.d0
187  else if( type_name_list(i)(1:2) == 'PZ' ) then
188  lid = 10; params(1,:)=0.d0; params(2,:)=0.d0; params(3,:)=1.d0
189  else if( type_name_list(i)(1:2) == 'P1' ) then; lid = 10
190  else if( type_name_list(i)(1:2) == 'P2' ) then; lid = 20
191  else if( type_name_list(i)(1:2) == 'P3' ) then; lid = 30
192  else if( type_name_list(i)(1:2) == 'P4' ) then; lid = 40
193  else if( type_name_list(i)(1:2) == 'P5' ) then; lid = 50
194  else if( type_name_list(i)(1:2) == 'P6' ) then; lid = 60
195  else if( type_name_list(i)(1:1) == 'S' ) then; lid = 100
196  else
197  write(ilog, *) 'Error : !DLOAD : Load type ',type_name_list(i), ' is unknown'
198  deallocate( type_name_list )
199  return
200  end if
201  load_type(i) = lid
202  end do
203 
204  deallocate( type_name_list )
205  fstr_ctrl_get_dload = 0
206 
207  end function fstr_ctrl_get_dload
208 
209 
210 
211  !* ----------------------------------------------------------------------------------------------- *!
213  !* ----------------------------------------------------------------------------------------------- *!
214 
215  function fstr_ctrl_get_reftemp( ctrl, value )
216  implicit none
217  integer(kind=kint) :: ctrl
218  real(kind=kreal) :: value
219  integer(kind=kint) :: fstr_ctrl_get_reftemp,rcode
220 
221  rcode = fstr_ctrl_get_data_array_ex( ctrl, 'r ', value )
222  fstr_ctrl_get_reftemp = rcode
223 
224  end function fstr_ctrl_get_reftemp
225 
226  !* ----------------------------------------------------------------------------------------------- *!
228  !* ----------------------------------------------------------------------------------------------- *!
229 
230  function fstr_ctrl_get_temperature( ctrl, irres, tstep, tintl, rtype, node_id, node_id_len, value )
231  implicit none
232  integer(kind=kint) :: ctrl
233  integer(kind=kint) :: irres
234  integer(kind=kint) :: tstep
235  integer(kind=kint) :: tintl
236  integer(kind=kint) :: rtype
237  character(len=HECMW_NAME_LEN), target :: node_id(:)
238  character(len=HECMW_NAME_LEN), pointer:: node_id_p
239  integer(kind=kint) :: node_id_len
240  real(kind=kreal),pointer :: value(:)
241  integer(kind=kint) :: fstr_ctrl_get_temperature, rcode
242 
243  character(len=HECMW_NAME_LEN) :: data_fmt,ss
244 
245  irres = 0
246  if( fstr_ctrl_get_param_ex( ctrl, 'READRESULT ', '# ', 0, 'I', irres )/= 0) return
247  if( fstr_ctrl_get_param_ex( ctrl, 'SSTEP ', '# ', 0, 'I', tstep )/= 0) return
248  if( fstr_ctrl_get_param_ex( ctrl, 'INTERVAL ', '# ', 0, 'I', tintl )/= 0) return
249  if( fstr_ctrl_get_param_ex( ctrl, 'READTYPE ', 'STEP,TIME ', 0, 'P', rtype )/= 0) return
250  if( irres > 0 ) then
251  fstr_ctrl_get_temperature = 0
252  return
253  endif
254 
255  write(ss,*) node_id_len
256  write(data_fmt,'(a,a,a)') 'S',trim(adjustl(ss)),'r '
257 
258  node_id_p => node_id(1)
259  rcode = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, node_id_p, value )
260  fstr_ctrl_get_temperature = rcode
261 
262  end function fstr_ctrl_get_temperature
263 
264 
265  !* ----------------------------------------------------------------------------------------------- *!
267  !* ----------------------------------------------------------------------------------------------- *!
268 
269  function fstr_ctrl_get_spring( ctrl, amp, node_id, node_id_len, dof_id, value )
270  implicit none
271  integer(kind=kint) :: ctrl
272  character(len=HECMW_NAME_LEN) :: amp
273  character(len=HECMW_NAME_LEN),target :: node_id(:)
274  character(len=HECMW_NAME_LEN),pointer :: node_id_p
275  integer(kind=kint) :: node_id_len
276  integer(kind=kint),pointer :: dof_id(:)
277  real(kind=kreal),pointer :: value(:)
278  integer(kind=kint) :: fstr_ctrl_get_spring
279 
280  character(len=HECMW_NAME_LEN) :: data_fmt,ss
281  write(ss,*) node_id_len
282  write( data_fmt, '(a,a,a)') 'S', trim(adjustl(ss)), 'IR '
283 
284  fstr_ctrl_get_spring = -1
285  if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
286  node_id_p => node_id(1)
287  fstr_ctrl_get_spring = &
288  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, node_id_p, dof_id, value )
289 
290  end function fstr_ctrl_get_spring
291 
292 
293  !----------------------------------------------------------------------
295  integer function fstr_ctrl_get_userload( ctrl )
296  use muload
297  integer(kind=kint), intent(in) :: ctrl
298 
299  character(len=256) :: fname
300 
301  fstr_ctrl_get_userload = -1
302  if( fstr_ctrl_get_param_ex( ctrl, 'FILE ', '# ', 0, 'S', fname )/=0 ) return
303  if( fname=="" ) stop "You must define a file name before read in user-defined material"
304  if( ureadload(fname)/=0 ) return
305 
306  fstr_ctrl_get_userload = 0
307  end function fstr_ctrl_get_userload
308 
309 end module fstr_ctrl_static
310 
311 
312 
313 
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)
Read in !SPRING.
Definition: fstr_ctrl_static.f90:270
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:40
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:127
muload
This subroutine read in used-defined loading tangent.
Definition: uload.f90:7
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:100
m_fstr::eps
real(kind=kreal) eps
Definition: m_fstr.f90:142
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:71
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.f90:15
muload::ureadload
integer function ureadload(fname)
This subroutine read in variables needs to define user-defined external loads.
Definition: uload.f90:25
fstr_ctrl_static
This module contains control file data obtaining functions for static analysis.
Definition: fstr_ctrl_static.f90:6
fstr_ctrl_get_data_line_n
int fstr_ctrl_get_data_line_n(int *ctrl)
Definition: fstr_ctrl_util.c:1462
fstr_ctrl_static::fstr_ctrl_get_userload
integer function fstr_ctrl_get_userload(ctrl)
Read in !ULOAD.
Definition: fstr_ctrl_static.f90:296
hecmw
Definition: hecmw.f90:6
fstr_ctrl_static::fstr_ctrl_get_reftemp
integer(kind=kint) function fstr_ctrl_get_reftemp(ctrl, value)
Read in !REFTEMP.
Definition: fstr_ctrl_static.f90:216
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:1404
m_fstr::irres
integer(kind=kint), pointer irres
Definition: m_fstr.f90:125
fstr_ctrl_get_data_array_ex
int fstr_ctrl_get_data_array_ex(int *ctrl, const char *format,...)
Definition: fstr_ctrl_util.c:1701
fstr_ctrl_get_data_ex
int fstr_ctrl_get_data_ex(int *ctrl, int *line_no, const char *format,...)
Definition: fstr_ctrl_util.c:1628
m_fstr::etime
real(kind=kreal) etime
Definition: m_fstr.f90:140
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:107
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:231