FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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!-------------------------------------------------------------------------------
7 use m_fstr
8 use hecmw
9 include 'fstr_ctrl_util_f.inc'
10
11 private :: pc_strupr
12contains
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
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
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
87 if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
88 node_id_p => node_id(1)
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
115 if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
116 node_id_p => node_id(1)
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
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
157 allocate( type_name_list(n) )
158 !!
159 !! for avoiding stack overflow with intel 9 complier
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 )
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 )
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
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 )
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
285 if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
286 node_id_p => node_id(1)
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
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_usermaterial = 0
307 end function fstr_ctrl_get_userload
308
309end module fstr_ctrl_static
310
311
312
313
int fstr_ctrl_get_param_ex(int *ctrl, const char *param_name, const char *value_list, int *necessity, char *type, void *val)
int fstr_ctrl_get_data_line_n(int *ctrl)
int fstr_ctrl_get_data_array_ex(int *ctrl, const char *format,...)
int fstr_ctrl_get_data_ex(int *ctrl, int *line_no, const char *format,...)
This module contains control file data obtaining functions for static analysis.
integer(kind=kint) function fstr_ctrl_get_spring(ctrl, amp, node_id, node_id_len, dof_id, value)
Read in !SPRING.
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.
integer(kind=kint) function fstr_ctrl_get_boundary(ctrl, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !BOUNDARY.
integer(kind=kint) function fstr_ctrl_get_reftemp(ctrl, value)
Read in !REFTEMP.
integer(kind=kint) function fstr_ctrl_get_dload(ctrl, amp, follow, element_id, element_id_len, load_type, params)
Read in !DLOAD.
integer(kind=kint) function fstr_ctrl_get_temperature(ctrl, irres, tstep, tintl, rtype, node_id, node_id_len, value)
Read in !TEMPERATURE.
integer(kind=kint) function fstr_ctrl_get_cload(ctrl, amp, node_id, node_id_len, dof_id, value)
Read in !CLOAD.
integer function fstr_ctrl_get_userload(ctrl)
Read in !ULOAD.
Definition: hecmw.f90:6
This module defined coomon data and basic structures for analysis.
Definition: m_fstr.f90:15
real(kind=kreal) eps
Definition: m_fstr.f90:126
real(kind=kreal) etime
Definition: m_fstr.f90:124
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:91
integer(kind=kint), pointer irres
Definition: m_fstr.f90:109
This subroutine read in used-defined loading tangent.
Definition: uload.f90:7
integer function ureadload(fname)
This suborutine read in variables needs to define user-defined external loads.
Definition: uload.f90:25