10 include
'fstr_ctrl_util_f.inc'
16 subroutine pc_strupr( s )
19 integer :: i, n, a, da
22 da = iachar(
'a') - iachar(
'A')
25 if( a > iachar(
'Z'))
then
30 end subroutine pc_strupr
37 integer(kind=kint) :: ctrl
38 real(kind=kreal),
pointer ::
dt(:)
39 real(kind=kreal),
pointer ::
etime(:)
40 real(kind=kreal),
pointer :: dtmin(:)
41 real(kind=kreal),
pointer :: deltmx(:)
42 integer(kind=kint),
pointer ::
itmax(:)
43 real(kind=kreal),
pointer ::
eps(:)
44 character(len=*),
intent(out) :: tpname
47 integer(kind=kint) :: result
63 integer(kind=kint) :: ctrl
64 character(len=HECMW_NAME_LEN) :: amp
65 character(len=HECMW_NAME_LEN),
target :: node_grp_name(:)
66 character(len=HECMW_NAME_LEN),
pointer:: node_grp_name_p
67 integer(kind=kint) :: node_grp_name_len
68 real(kind=kreal),
pointer :: value(:)
71 character(len=HECMW_NAME_LEN) :: data_fmt,ss
78 write(ss,*) node_grp_name_len
79 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'r '
81 node_grp_name_p => node_grp_name(1)
90 integer(kind=kint) :: ctrl
91 character(len=HECMW_NAME_LEN) :: amp
92 character(len=HECMW_NAME_LEN),
target :: node_grp_name(:)
93 character(len=HECMW_NAME_LEN),
pointer:: node_grp_name_p
94 integer(kind=kint) :: node_grp_name_len
95 real(kind=kreal),
pointer :: value(:)
98 character(len=HECMW_NAME_LEN) :: data_fmt,ss
105 write(ss,*) node_grp_name_len
106 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'r '
108 node_grp_name_p => node_grp_name(1)
116 integer(kind=kint) :: ctrl
117 character(len=HECMW_NAME_LEN) :: amp
118 character(len=HECMW_NAME_LEN),
target :: elem_grp_name(:)
119 character(len=HECMW_NAME_LEN),
pointer:: elem_grp_name_p
120 integer(kind=kint) :: elem_grp_name_len
121 integer(kind=kint),
pointer :: load_type(:)
122 real(kind=kreal),
pointer :: value(:)
125 integer(kind=kint),
parameter :: type_name_size = 5
126 integer(kind=kint) :: i, n
127 character(len=HECMW_NAME_LEN) :: data_fmt,s1,s2
128 character(len=type_name_size),
pointer :: type_name_list(:)
129 character(len=type_name_size),
pointer :: type_name_list_p
130 integer(kind=kint) :: rcode
131 integer(kind=kint) :: lid = -1
138 write(s1,*) elem_grp_name_len
139 write(s2,*) type_name_size
140 write(data_fmt,
'(a,a,a,a,a)')
'S',trim(adjustl(s1)),
'S',trim(adjustl(s2)),
'r '
143 allocate( type_name_list(n) )
145 elem_grp_name_p => elem_grp_name(1)
146 type_name_list_p => type_name_list(1)
149 if( rcode /= 0 )
then
150 deallocate( type_name_list )
156 call pc_strupr( type_name_list(i) )
157 if( type_name_list(i)(1:2) ==
'BF' ) then; lid = 0
158 else if( type_name_list(i)(1:2) ==
'S0' ) then; lid = 1
159 else if( type_name_list(i)(1:2) ==
'S1' ) then; lid = 1
160 else if( type_name_list(i)(1:2) ==
'S2' ) then; lid = 2
161 else if( type_name_list(i)(1:2) ==
'S3' ) then; lid = 3
162 else if( type_name_list(i)(1:2) ==
'S4' ) then; lid = 4
163 else if( type_name_list(i)(1:2) ==
'S5' ) then; lid = 5
164 else if( type_name_list(i)(1:2) ==
'S6' ) then; lid = 6
167 write(
ilog,*)
'Error : !DFLUX : Load type ',type_name_list(i),
' is unknown'
168 deallocate( type_name_list )
174 deallocate( type_name_list )
184 integer(kind=kint) :: ctrl
185 character(len=HECMW_NAME_LEN) :: amp
186 character(len=HECMW_NAME_LEN),
target :: surface_grp_name(:)
187 character(len=HECMW_NAME_LEN),
pointer:: surface_grp_name_p
188 integer(kind=kint) :: surface_grp_name_len
189 real(kind=kreal),
pointer :: value(:)
192 character(len=HECMW_NAME_LEN) :: data_fmt,ss
199 write(ss,*) surface_grp_name_len
200 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'r '
202 surface_grp_name_p => surface_grp_name(1)
211 function fstr_ctrl_get_film( ctrl, amp1, amp2, elem_grp_name, elem_grp_name_len, load_type, value, sink)
213 integer(kind=kint) :: ctrl
214 character(len=HECMW_NAME_LEN) :: amp1
215 character(len=HECMW_NAME_LEN) :: amp2
216 character(len=HECMW_NAME_LEN),
target :: elem_grp_name(:)
217 character(len=HECMW_NAME_LEN),
pointer:: elem_grp_name_p
218 integer(kind=kint) :: elem_grp_name_len
219 integer(kind=kint),
pointer :: load_type(:)
220 real(kind=kreal),
pointer :: value(:)
221 real(kind=kreal),
pointer :: sink(:)
224 integer(kind=kint),
parameter :: type_name_size = 5
225 integer(kind=kint) :: i, n
226 character(len=HECMW_NAME_LEN) :: data_fmt,s1,s2
227 character(len=type_name_size),
pointer :: type_name_list(:)
228 character(len=type_name_size),
pointer :: type_name_list_p
229 integer(kind=kint) :: lid
230 integer(kind=kint) :: rcode
238 write(s1,*) elem_grp_name_len
239 write(s2,*) type_name_size
240 write(data_fmt,
'(a,a,a,a,a)')
'S',trim(adjustl(s1)),
'S',trim(adjustl(s2)),
'Rr '
243 allocate( type_name_list(n) )
245 elem_grp_name_p => elem_grp_name(1)
246 type_name_list_p => type_name_list(1)
249 if( rcode /= 0 )
then
250 deallocate( type_name_list )
256 call pc_strupr( type_name_list(i) )
257 if( type_name_list(i)(1:2) ==
'F0' ) then; lid = 1
258 else if( type_name_list(i)(1:2) ==
'F1' ) then; lid = 1
259 else if( type_name_list(i)(1:2) ==
'F2' ) then; lid = 2
260 else if( type_name_list(i)(1:2) ==
'F3' ) then; lid = 3
261 else if( type_name_list(i)(1:2) ==
'F4' ) then; lid = 4
262 else if( type_name_list(i)(1:2) ==
'F5' ) then; lid = 5
263 else if( type_name_list(i)(1:2) ==
'F6' ) then; lid = 6
266 write(
ilog,*)
'Error : !FILM : Load type ',type_name_list(i),
' is unknown'
267 deallocate( type_name_list )
273 deallocate( type_name_list )
284 integer(kind=kint) :: ctrl
285 character(len=HECMW_NAME_LEN) :: amp1
286 character(len=HECMW_NAME_LEN) :: amp2
287 character(len=HECMW_NAME_LEN),
target :: surface_grp_name(:)
288 character(len=HECMW_NAME_LEN),
pointer:: surface_grp_name_p
289 integer(kind=kint) :: surface_grp_name_len
290 real(kind=kreal),
pointer :: value(:)
291 real(kind=kreal),
pointer :: sink(:)
294 character(len=HECMW_NAME_LEN) :: data_fmt,ss
302 write(ss,*) surface_grp_name_len
303 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'Rr '
305 surface_grp_name_p => surface_grp_name(1)
316 integer(kind=kint) :: ctrl
317 character(len=HECMW_NAME_LEN) :: amp1
318 character(len=HECMW_NAME_LEN) :: amp2
319 character(len=HECMW_NAME_LEN),
target :: elem_grp_name(:)
320 character(len=HECMW_NAME_LEN),
pointer:: elem_grp_name_p
321 integer(kind=kint) :: elem_grp_name_len
322 integer(kind=kint),
pointer :: load_type(:)
323 real(kind=kreal),
pointer :: value(:)
324 real(kind=kreal),
pointer :: sink(:)
327 integer(kind=kint),
parameter :: type_name_size = 5
328 integer(kind=kint) :: i, n
329 character(len=HECMW_NAME_LEN) :: data_fmt,s1,s2
330 character(len=type_name_size),
pointer :: type_name_list(:)
331 character(len=type_name_size),
pointer :: type_name_list_p
332 integer(kind=kint) :: lid
333 integer(kind=kint) :: rcode
341 write(s1,*) elem_grp_name_len
342 write(s2,*) type_name_size
343 write(data_fmt,
'(a,a,a,a,a)')
'S',trim(adjustl(s1)),
'S',trim(adjustl(s2)),
'Rr '
346 allocate( type_name_list(n) )
348 elem_grp_name_p => elem_grp_name(1)
349 type_name_list_p => type_name_list(1)
352 if( rcode /= 0 )
then
353 deallocate( type_name_list )
359 call pc_strupr( type_name_list(i) )
360 if( type_name_list(i)(1:2) ==
'R0' ) then; lid = 1
361 else if( type_name_list(i)(1:2) ==
'R1' ) then; lid = 1
362 else if( type_name_list(i)(1:2) ==
'R2' ) then; lid = 2
363 else if( type_name_list(i)(1:2) ==
'R3' ) then; lid = 3
364 else if( type_name_list(i)(1:2) ==
'R4' ) then; lid = 4
365 else if( type_name_list(i)(1:2) ==
'R5' ) then; lid = 5
366 else if( type_name_list(i)(1:2) ==
'R6' ) then; lid = 6
369 write(
ilog,*)
'Error : !RADIATE : Load type ',type_name_list(i),
' is unknown'
370 deallocate( type_name_list )
376 deallocate( type_name_list )
387 integer(kind=kint) :: ctrl
388 character(len=HECMW_NAME_LEN) :: amp1
389 character(len=HECMW_NAME_LEN) :: amp2
390 character(len=HECMW_NAME_LEN),
target :: surface_grp_name(:)
391 character(len=HECMW_NAME_LEN),
pointer:: surface_grp_name_p
392 integer(kind=kint) :: surface_grp_name_len
393 real(kind=kreal),
pointer :: value(:)
394 real(kind=kreal),
pointer :: sink(:)
397 character(len=HECMW_NAME_LEN) :: data_fmt
398 character(len=HECMW_NAME_LEN) :: s1
406 write(s1,*) surface_grp_name_len;
407 write(data_fmt,
'(a,a,a)')
'S', trim(adjustl(s1)),
'Rr '
409 surface_grp_name_p => surface_grp_name(1)
421 integer(kind=kint),
intent(in) :: ctrl
422 type(hecmwst_local_mesh),
intent(in) :: hecmesh
423 integer(kind=kint),
intent(in) :: grp_name_len
424 type(
tweldline),
intent(inout) :: weldline
427 character(len=HECMW_NAME_LEN) :: data_fmt
428 character(len=HECMW_NAME_LEN) :: s1, grp_id_name(1)
432 if(
fstr_ctrl_get_data_ex( ctrl, 1,
'RRRR ', weldline%I, weldline%U, weldline%coe, weldline%v )/=0 )
return
433 write(s1,*) grp_name_len
434 write(data_fmt,
'(a,a,a)')
'S', trim(adjustl(s1)),
'IRRRR '
436 weldline%n2, weldline%distol, weldline%tstart )/=0 )
return
438 weldline%egrpid = grp_id(1)
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 heat conductive analysis.
integer(kind=kint) function fstr_ctrl_get_heat(ctrl, dt, etime, dtmin, deltmx, itmax, eps, tpname)
Read in !HEAT.
integer(kind=kint) function fstr_ctrl_get_dflux(ctrl, amp, elem_grp_name, elem_grp_name_len, load_type, value)
Read in !DFLUX (heat)
integer(kind=kint) function fstr_ctrl_get_sflux(ctrl, amp, surface_grp_name, surface_grp_name_len, value)
Read in !SFLUX (heat)
integer(kind=kint) function fstr_ctrl_get_weldline(ctrl, hecmesh, grp_name_len, weldline)
Read in !WELD_LINE (heat)
integer(kind=kint) function fstr_ctrl_get_film(ctrl, amp1, amp2, elem_grp_name, elem_grp_name_len, load_type, value, sink)
Read in !FILM (heat)
integer(kind=kint) function fstr_ctrl_get_radiate(ctrl, amp1, amp2, elem_grp_name, elem_grp_name_len, load_type, value, sink)
Read in !RADIATE (heat)
integer(kind=kint) function fstr_ctrl_get_cflux(ctrl, amp, node_grp_name, node_grp_name_len, value)
Read in !CFLUX (heat)
integer(kind=kint) function fstr_ctrl_get_fixtemp(ctrl, amp, node_grp_name, node_grp_name_len, value)
Read in !FIXTEMP.
integer(kind=kint) function fstr_ctrl_get_sfilm(ctrl, amp1, amp2, surface_grp_name, surface_grp_name_len, value, sink)
Read in !SFILM (heat)
integer(kind=kint) function fstr_ctrl_get_sradiate(ctrl, amp1, amp2, surface_grp_name, surface_grp_name_len, value, sink)
Read in !SRADIATE (heat)
This module contains auxiliary functions in calculation setup.
subroutine elem_grp_name_to_id(hecmesh, header_name, n, grp_id_name, grp_id)
This module defined coomon data and basic structures for analysis.
integer(kind=kint), parameter ilog
FILE HANDLER.
real(kind=kreal) dt
ANALYSIS CONTROL for NLGEOM and HEAT.