FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
fstr_ctrl_common.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
8 use m_fstr
9 use hecmw
10 use mcontact
11 use m_timepoint
12
13 implicit none
14
15 include 'fstr_ctrl_util_f.inc'
16
17 private :: pc_strupr
18
19contains
20
21 subroutine pc_strupr( s )
22 implicit none
23 character(*) :: s
24 integer :: i, n, a, da
25
26 n = len_trim(s)
27 da = iachar('a') - iachar('A')
28 do i = 1, n
29 a = iachar(s(i:i))
30 if( a > iachar('Z')) then
31 a = a - da
32 s(i:i) = achar(a)
33 end if
34 end do
35 end subroutine pc_strupr
36
37
39 function fstr_ctrl_get_solution( ctrl, type, nlgeom )
40 integer(kind=kint) :: ctrl
41 integer(kind=kint) :: type
42 logical :: nlgeom
43 integer(kind=kint) :: fstr_ctrl_get_solution
44
45 integer(kind=kint) :: ipt
46 character(len=80) :: s
47
49
50 s = 'ELEMCHECK,STATIC,EIGEN,HEAT,DYNAMIC,NLSTATIC,STATICEIGEN,NZPROF '
51 if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 1, 'P', type )/= 0) return
52 type = type -1
53
54 ipt=0
55 if( fstr_ctrl_get_param_ex( ctrl, 'NONLINEAR ', '# ', 0, 'E', ipt )/= 0) return
56 if( ipt/=0 .and. ( type == kststatic .or. type == kstdynamic )) nlgeom = .true.
57
58 if( type == 5 ) then !if type == NLSTATIC
59 type = kststatic
60 nlgeom = .true.
61 end if
62 if( type == kststaticeigen ) nlgeom = .true.
63
65 end function fstr_ctrl_get_solution
66
67
69 function fstr_ctrl_get_solver( ctrl, method, precond, nset, iterlog, timelog, steplog, nier, &
70 iterpremax, nrest, scaling, &
71 dumptype, dumpexit, usejad, ncolor_in, mpc_method, estcond, method2, recyclepre, &
72 solver_opt1, solver_opt2, solver_opt3, solver_opt4, solver_opt5, solver_opt6, &
73 resid, singma_diag, sigma, thresh, filter )
74 integer(kind=kint) :: ctrl
75 integer(kind=kint) :: method
76 integer(kind=kint) :: precond
77 integer(kind=kint) :: nset
78 integer(kind=kint) :: iterlog
79 integer(kind=kint) :: timelog
80 integer(kind=kint) :: steplog
81 integer(kind=kint) :: nier
82 integer(kind=kint) :: iterpremax
83 integer(kind=kint) :: nrest
84 integer(kind=kint) :: scaling
85 integer(kind=kint) :: dumptype
86 integer(kind=kint) :: dumpexit
87 integer(kind=kint) :: usejad
88 integer(kind=kint) :: ncolor_in
89 integer(kind=kint) :: mpc_method
90 integer(kind=kint) :: estcond
91 integer(kind=kint) :: method2
92 integer(kind=kint) :: recyclepre
93 integer(kind=kint) :: solver_opt1
94 integer(kind=kint) :: solver_opt2
95 integer(kind=kint) :: solver_opt3
96 integer(kind=kint) :: solver_opt4
97 integer(kind=kint) :: solver_opt5
98 integer(kind=kint) :: solver_opt6
99 real(kind=kreal) :: resid
100 real(kind=kreal) :: singma_diag
101 real(kind=kreal) :: sigma
102 real(kind=kreal) :: thresh
103 real(kind=kreal) :: filter
104 integer(kind=kint) :: fstr_ctrl_get_solver
105
106 character(92) :: mlist = '1,2,3,4,101,CG,BiCGSTAB,GMRES,GPBiCG,DIRECT,DIRECTmkl,DIRECTlag,MUMPS,MKL '
107 character(24) :: dlist = '0,1,2,3,NONE,MM,CSR,BSR '
108
109 integer(kind=kint) :: number_number = 5
110 integer(kind=kint) :: indirect_number = 4
111 integer(kind=kint) :: iter, time, sclg, dmpt, dmpx, usjd, step
112
114
115 iter = iterlog+1
116 time = timelog+1
117 step = steplog+1
118 sclg = scaling+1
119 dmpt = dumptype+1
120 dmpx = dumpexit+1
121 usjd = usejad+1
122 !* parameter in header line -----------------------------------------------------------------*!
123
124 ! JP-0
125 if( fstr_ctrl_get_param_ex( ctrl, 'METHOD ', mlist, 1, 'P', method ) /= 0) return
126 if( fstr_ctrl_get_param_ex( ctrl, 'PRECOND ', '1,2,3,4,5,6,7,8,9,10,11,12,20,21,30,31,32 ' ,0, 'I', precond ) /= 0) return
127 if( fstr_ctrl_get_param_ex( ctrl, 'NSET ', '0,-1,+1 ', 0, 'I', nset ) /= 0) return
128 if( fstr_ctrl_get_param_ex( ctrl, 'ITERLOG ', 'NO,YES ', 0, 'P', iter ) /= 0) return
129 if( fstr_ctrl_get_param_ex( ctrl, 'TIMELOG ', 'NO,YES,VERBOSE ', 0, 'P', time ) /= 0) return
130 if( fstr_ctrl_get_param_ex( ctrl, 'STEPLOG ', 'NO,YES ', 0, 'P', step ) /= 0) return
131 if( fstr_ctrl_get_param_ex( ctrl, 'SCALING ', 'NO,YES ', 0, 'P', sclg ) /= 0) return
132 if( fstr_ctrl_get_param_ex( ctrl, 'DUMPTYPE ', dlist, 0, 'P', dmpt ) /= 0) return
133 if( fstr_ctrl_get_param_ex( ctrl, 'DUMPEXIT ','NO,YES ', 0, 'P', dmpx ) /= 0) return
134 if( fstr_ctrl_get_param_ex( ctrl, 'USEJAD ' ,'NO,YES ', 0, 'P', usjd ) /= 0) return
135 if( fstr_ctrl_get_param_ex( ctrl, 'MPCMETHOD ','# ', 0, 'I',mpc_method) /= 0) return
136 if( fstr_ctrl_get_param_ex( ctrl, 'ESTCOND ' ,'# ', 0, 'I',estcond ) /= 0) return
137 if( fstr_ctrl_get_param_ex( ctrl, 'METHOD2 ', mlist, 0, 'P', method2 ) /= 0) return
138 ! JP-1
139 if( method > number_number ) then ! JP-2
140 method = method - number_number
141 if( method > indirect_number ) then
142 ! JP-3
143 method = method - indirect_number + 100
144 if( method == 103 ) method = 101 ! DIRECTlag => DIRECT
145 if( method == 105 ) method = 102 ! MKL => DIRECTmkl
146 end if
147 end if
148 if( method2 > number_number ) then ! JP-2
149 method2 = method2 - number_number
150 if( method2 > indirect_number ) then
151 ! JP-3
152 method2 = method2 - indirect_number + 100
153 end if
154 end if
155
156 dumptype = dmpt - 1
157 if( dumptype >= 4 ) then
158 dumptype = dumptype - 4
159 end if
160
161 !* data --------------------------------------------------------------------------------------- *!
162 ! JP-4
163 if( fstr_ctrl_get_data_ex( ctrl, 1, 'iiiii ', nier, iterpremax, nrest, ncolor_in, recyclepre )/= 0) return
164 if( fstr_ctrl_get_data_ex( ctrl, 2, 'rrr ', resid, singma_diag, sigma )/= 0) return
165
166 if( precond == 20 .or. precond == 21) then
167 if( fstr_ctrl_get_data_ex( ctrl, 3, 'rr ', thresh, filter)/= 0) return
168 else if( precond == 5 ) then
169 if( fstr_ctrl_get_data_ex( ctrl, 3, 'iiiiii ', solver_opt1, solver_opt2, solver_opt3, &
170 & solver_opt4, solver_opt5, solver_opt6 )/= 0) return
171 else if( method == 101 ) then
172 if( fstr_ctrl_get_data_ex( ctrl, 3, 'i ', solver_opt1 )/= 0) return
173 end if
174
175 iterlog = iter -1
176 timelog = time -1
177 steplog = step -1
178 scaling = sclg -1
179 dumpexit = dmpx -1
180 usejad = usjd -1
181
183
184 end function fstr_ctrl_get_solver
185
186
188 function fstr_ctrl_get_step( ctrl, amp, iproc )
189 integer(kind=kint) :: ctrl
190 character(len=HECMW_NAME_LEN) :: amp
191 integer(kind=kint) :: iproc
192 integer(kind=kint) :: fstr_ctrl_get_step
193
194 integer(kind=kint) :: ipt = 0
195 integer(kind=kint) :: ip = 0
196
198
199 if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
200 if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', 'STANDARD,NLGEOM ', 0, 'P', ipt )/= 0) return
201 if( fstr_ctrl_get_param_ex( ctrl, 'NLGEOM ', '# ', 0, 'E', ip )/= 0) return
202
203 if( ipt == 2 .or. ip == 1 ) iproc = 1
204
206
207 end function fstr_ctrl_get_step
208
210 logical function fstr_ctrl_get_istep( ctrl, hecMESH, steps, tpname, apname )
212 use m_step
213 integer(kind=kint), intent(in) :: ctrl
214 type (hecmwst_local_mesh), intent(in) :: hecmesh
215 type(step_info), intent(out) :: steps
216 character(len=*), intent(out) :: tpname
217 character(len=*), intent(out) :: apname
218
219 character(len=HECMW_NAME_LEN) :: data_fmt,ss, data_fmt1
220 character(len=HECMW_NAME_LEN) :: amp
221 character(len=HECMW_NAME_LEN) :: header_name
222 integer(kind=kint) :: bcid
223 integer(kind=kint) :: i, n, sn, ierr
224 integer(kind=kint) :: bc_n, load_n, contact_n
225 real(kind=kreal) :: fn, f1, f2, f3
226
227 fstr_ctrl_get_istep = .false.
228
229 write(ss,*) hecmw_name_len
230 write( data_fmt, '(a,a,a)') 'S', trim(adjustl(ss)), 'I '
231 write( data_fmt1, '(a,a,a)') 'S', trim(adjustl(ss)),'rrr '
232
233 call init_stepinfo(steps)
234 steps%solution = stepstatic
235 if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', 'STATIC,VISCO ', 0, 'P', steps%solution )/= 0) return
236 steps%inc_type = stepfixedinc
237 if( fstr_ctrl_get_param_ex( ctrl, 'INC_TYPE ', 'FIXED,AUTO ', 0, 'P', steps%inc_type )/= 0) return
238 if( fstr_ctrl_get_param_ex( ctrl, 'SUBSTEPS ', '# ', 0, 'I', steps%num_substep )/= 0) return
239 steps%initdt = 1.d0/steps%num_substep
240 if( fstr_ctrl_get_param_ex( ctrl, 'ITMAX ', '# ', 0, 'I', steps%max_iter )/= 0) return
241 if( fstr_ctrl_get_param_ex( ctrl, 'MAXITER ', '# ', 0, 'I', steps%max_iter )/= 0) return
242 if( fstr_ctrl_get_param_ex( ctrl, 'MAXCONTITER ', '# ', 0, 'I', steps%max_contiter )/= 0) return
243 if( fstr_ctrl_get_param_ex( ctrl, 'CONVERG ', '# ', 0, 'R', steps%converg )/= 0) return
244 if( fstr_ctrl_get_param_ex( ctrl, 'MAXRES ', '# ', 0, 'R', steps%maxres )/= 0) return
245 amp = ""
246 if( fstr_ctrl_get_param_ex( ctrl, 'AMP ', '# ', 0, 'S', amp )/= 0) return
247 if( len( trim(amp) )>0 ) then
248 call amp_name_to_id( hecmesh, '!STEP', amp, steps%amp_id )
249 endif
250 tpname=""
251 if( fstr_ctrl_get_param_ex( ctrl, 'TIMEPOINTS ', '# ', 0, 'S', tpname )/= 0) return
252 apname=""
253 if( fstr_ctrl_get_param_ex( ctrl, 'AUTOINCPARAM ', '# ', 0, 'S', apname )/= 0) return
254
255 n = fstr_ctrl_get_data_line_n( ctrl )
256 if( n == 0 ) then
257 fstr_ctrl_get_istep = .true.; return
258 endif
259
260 f2 = steps%mindt
261 f3 = steps%maxdt
262 if( fstr_ctrl_get_data_ex( ctrl, 1, data_fmt1, ss, f1, f2, f3 )/= 0) return
263 read( ss, * , iostat=ierr ) fn
264 sn=1
265 if( ierr==0 ) then
266 steps%initdt = fn
267 steps%elapsetime = f1
268 if( steps%inc_type == stepautoinc ) then
269 steps%mindt = min(f2,steps%initdt)
270 steps%maxdt = f3
271 endif
272 steps%num_substep = max(int((f1+0.999999999d0*fn)/fn),steps%num_substep)
273 !if( mod(f1,fn)/=0 ) steps%num_substep =steps%num_substep+1
274 sn = 2
275 endif
276
277 bc_n = 0
278 load_n = 0
279 contact_n = 0
280 do i=sn,n
281 if( fstr_ctrl_get_data_ex( ctrl, i, data_fmt, header_name, bcid )/= 0) return
282 if( trim(header_name) == 'BOUNDARY' ) then
283 bc_n = bc_n + 1
284 else if( trim(header_name) == 'LOAD' ) then
285 load_n = load_n +1
286 else if( trim(header_name) == 'CONTACT' ) then
287 contact_n = contact_n+1
288 else if( trim(header_name) == 'TEMPERATURE' ) then
289 ! steps%Temperature = .true.
290 endif
291 end do
292
293 if( bc_n>0 ) allocate( steps%Boundary(bc_n) )
294 if( load_n>0 ) allocate( steps%Load(load_n) )
295 if( contact_n>0 ) allocate( steps%Contact(contact_n) )
296
297 bc_n = 0
298 load_n = 0
299 contact_n = 0
300 do i=sn,n
301 if( fstr_ctrl_get_data_ex( ctrl, i, data_fmt, header_name, bcid )/= 0) return
302 if( trim(header_name) == 'BOUNDARY' ) then
303 bc_n = bc_n + 1
304 steps%Boundary(bc_n) = bcid
305 else if( trim(header_name) == 'LOAD' ) then
306 load_n = load_n +1
307 steps%Load(load_n) = bcid
308 else if( trim(header_name) == 'CONTACT' ) then
309 contact_n = contact_n+1
310 steps%Contact(contact_n) = bcid
311 endif
312 end do
313
314 fstr_ctrl_get_istep = .true.
315 end function fstr_ctrl_get_istep
316
318 integer function fstr_ctrl_get_section( ctrl, hecMESH, sections )
319 integer(kind=kint), intent(in) :: ctrl
320 type (hecmwst_local_mesh), intent(inout) :: hecmesh
321 type (tsection), pointer, intent(inout) :: sections(:)
322
323 integer(kind=kint) :: j, k, sect_id, ori_id, elemopt
324 integer(kind=kint),save :: cache = 1
325 character(len=HECMW_NAME_LEN) :: sect_orien
326 character(16) :: form361list = 'FI,BBAR,IC,FBAR '
327
329
330 if( fstr_ctrl_get_param_ex( ctrl, 'SECNUM ', '# ', 1, 'I', sect_id )/= 0) return
331 if( sect_id > hecmesh%section%n_sect ) return
332
333 elemopt = 0
334 if( fstr_ctrl_get_param_ex( ctrl, 'FORM361 ', form361list, 0, 'P', elemopt )/= 0) return
335 if( elemopt > 0 ) sections(sect_id)%elemopt361 = elemopt
336
337 ! sectional orientation ID
338 hecmesh%section%sect_orien_ID(sect_id) = -1
339 if( fstr_ctrl_get_param_ex( ctrl, 'ORIENTATION ', '# ', 0, 'S', sect_orien )/= 0) return
340
341 if( associated(g_localcoordsys) ) then
342 k = size(g_localcoordsys)
343
344 if(cache < k)then
345 if( sect_orien == g_localcoordsys(cache)%sys_name ) then
346 hecmesh%section%sect_orien_ID(sect_id) = cache
347 cache = cache + 1
349 return
350 endif
351 endif
352
353 do j=1, k
354 if( sect_orien == g_localcoordsys(j)%sys_name ) then
355 hecmesh%section%sect_orien_ID(sect_id) = j
356 cache = j + 1
357 exit
358 endif
359 enddo
360 endif
361
363
364 end function fstr_ctrl_get_section
365
366
368 function fstr_ctrl_get_write( ctrl, res, visual, femap )
369 integer(kind=kint) :: ctrl
370 integer(kind=kint) :: res
371 integer(kind=kint) :: visual
372 integer(kind=kint) :: femap
373 integer(kind=kint) :: fstr_ctrl_get_write
374
376
377 ! JP-6
378 if( fstr_ctrl_get_param_ex( ctrl, 'RESULT ', '# ', 0, 'E', res )/= 0) return
379 if( fstr_ctrl_get_param_ex( ctrl, 'VISUAL ', '# ', 0, 'E', visual )/= 0) return
380 if( fstr_ctrl_get_param_ex( ctrl, 'FEMAP ', '# ', 0, 'E', femap )/= 0) return
381
383
384 end function fstr_ctrl_get_write
385
387 function fstr_ctrl_get_echo( ctrl, echo )
388 integer(kind=kint) :: ctrl
389 integer(kind=kint) :: echo
390 integer(kind=kint) :: fstr_ctrl_get_echo
391
392 echo = kon;
393
395
396 end function fstr_ctrl_get_echo
397
399 function fstr_ctrl_get_couple( ctrl, fg_type, fg_first, fg_window, surf_id, surf_id_len )
400 integer(kind=kint) :: ctrl
401 integer(kind=kint) :: fg_type
402 integer(kind=kint) :: fg_first
403 integer(kind=kint) :: fg_window
404 character(len=HECMW_NAME_LEN),target :: surf_id(:)
405 character(len=HECMW_NAME_LEN),pointer :: surf_id_p
406 integer(kind=kint) :: surf_id_len
407 integer(kind=kint) :: fstr_ctrl_get_couple
408
409 character(len=HECMW_NAME_LEN) :: data_fmt,ss
410 write(ss,*) surf_id_len
411 write(data_fmt,'(a,a,a)') 'S',trim(adjustl(ss)),' '
412
414 if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', '1,2,3,4,5,6 ', 0, 'I', fg_type )/= 0) return
415 if( fstr_ctrl_get_param_ex( ctrl, 'ISTEP ', '# ', 0, 'I', fg_first )/= 0) return
416 if( fstr_ctrl_get_param_ex( ctrl, 'WINDOW ', '# ', 0, 'I', fg_window )/= 0) return
417
418 surf_id_p => surf_id(1)
420 fstr_ctrl_get_data_array_ex( ctrl, data_fmt, surf_id_p )
421
422 end function fstr_ctrl_get_couple
423
425 function fstr_ctrl_get_mpc( ctrl, penalty )
426 integer(kind=kint), intent(in) :: ctrl
427 real(kind=kreal), intent(out) :: penalty
428 integer(kind=kint) :: fstr_ctrl_get_mpc
429
430 fstr_ctrl_get_mpc = fstr_ctrl_get_data_ex( ctrl, 1, 'r ', penalty )
431 if( penalty <= 1.0 ) then
432 if (myrank == 0) then
433 write(imsg,*) "Warging : !MPC : too small penalty: ", penalty
434 write(*,*) "Warging : !MPC : too small penalty: ", penalty
435 endif
436 endif
437
438 end function fstr_ctrl_get_mpc
439
441 logical function fstr_ctrl_get_outitem( ctrl, hecMESH, outinfo )
443 use m_out
444 integer(kind=kint), intent(in) :: ctrl
445 type (hecmwst_local_mesh), intent(in) :: hecmesh
446 type( output_info ), intent(out) :: outinfo
447
448 integer(kind=kint) :: rcode, ipos
449 integer(kind=kint) :: n, i, j
450 character(len=HECMW_NAME_LEN) :: data_fmt, ss
451 character(len=HECMW_NAME_LEN), allocatable :: header_name(:), onoff(:), vtype(:)
452
453 write( ss, * ) hecmw_name_len
454 write( data_fmt, '(a,a,a,a,a)') 'S', trim(adjustl(ss)), 'S', trim(adjustl(ss)), ' '
455 ! write( data_fmt, '(a,a,a,a,a,a,a)') 'S', trim(adjustl(ss)), 'S', trim(adjustl(ss)), 'S', trim(adjustl(ss)), ' '
456
457 fstr_ctrl_get_outitem = .false.
458
459 outinfo%grp_id_name = "ALL"
460 rcode = fstr_ctrl_get_param_ex( ctrl, 'GROUP ', '# ', 0, 'S', outinfo%grp_id_name )
461 ipos = 0
462 rcode = fstr_ctrl_get_param_ex( ctrl, 'ACTION ', 'SUM ', 0, 'P', ipos )
463 outinfo%actn = ipos
464
465 n = fstr_ctrl_get_data_line_n( ctrl )
466 if( n == 0 ) return
467 allocate( header_name(n), onoff(n), vtype(n) )
468 header_name(:) = ""; vtype(:) = ""; onoff(:) = ""
469 rcode = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, header_name, onoff )
470 ! rcode = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, header_name, onoff, vtype )
471
472 do i = 1, n
473 do j = 1, outinfo%num_items
474 if( trim(header_name(i)) == outinfo%keyWord(j) ) then
475 outinfo%on(j) = .true.
476 if( trim(onoff(i)) == 'OFF' ) outinfo%on(j) = .false.
477 if( len( trim(vtype(i)) )>0 ) then
478 if( fstr_str2index( vtype(i), ipos ) ) then
479 outinfo%vtype(j) = ipos
480 else if( trim(vtype(i)) == "SCALER" ) then
481 outinfo%vtype(j) = -1
482 else if( trim(vtype(i)) == "VECTOR" ) then
483 outinfo%vtype(j) = -2
484 else if( trim(vtype(i)) == "SYMTENSOR" ) then
485 outinfo%vtype(j) = -3
486 else if( trim(vtype(i)) == "TENSOR" ) then
487 outinfo%vtype(j) = -4
488 endif
489 endif
490 endif
491 enddo
492 enddo
493
494 deallocate( header_name, onoff, vtype )
495 fstr_ctrl_get_outitem = .true.
496
497 end function fstr_ctrl_get_outitem
498
500 function fstr_ctrl_get_contactalgo( ctrl, algo )
501 integer(kind=kint) :: ctrl
502 integer(kind=kint) :: algo
503 integer(kind=kint) :: fstr_ctrl_get_contactalgo
504
505 integer(kind=kint) :: rcode
506 character(len=80) :: s
507 algo = kcaslagrange
508 s = 'SLAGRANGE,ALAGRANGE '
509 rcode = fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', algo )
511 end function fstr_ctrl_get_contactalgo
512
514 logical function fstr_ctrl_get_contact( ctrl, n, contact, np, tp, ntol, ttol, ctAlgo )
515 integer(kind=kint), intent(in) :: ctrl
516 integer(kind=kint), intent(in) :: n
517 integer(kind=kint), intent(in) :: ctalgo
518 type(tcontact), intent(out) :: contact(n)
519 real(kind=kreal), intent(out) :: np
520 real(kind=kreal), intent(out) :: tp
521 real(kind=kreal), intent(out) :: ntol
522 real(kind=kreal), intent(out) :: ttol
523
524 integer :: rcode, ipt
525 character(len=30) :: s1 = 'TIED,GLUED,SSLID,FSLID '
526 character(len=HECMW_NAME_LEN) :: data_fmt,ss
527 character(len=HECMW_NAME_LEN) :: cp_name(n)
528 real(kind=kreal) :: fcoeff(n),tpenalty(n)
529
530 tpenalty = 1.0d6
531
532 write(ss,*) hecmw_name_len
533 write( data_fmt, '(a,a,a)') 'S', trim(adjustl(ss)),'Rr '
534
535 fstr_ctrl_get_contact = .false.
536 contact(1)%ctype = 1 ! pure slave-master contact; default value
537 contact(1)%algtype = contactsslid ! small sliding contact; default value
538 rcode = fstr_ctrl_get_param_ex( ctrl, 'INTERACTION ', s1, 0, 'P', contact(1)%algtype )
539 if( contact(1)%algtype==contactglued ) contact(1)%algtype=contactfslid ! not complemented yet
540 if( fstr_ctrl_get_param_ex( ctrl, 'GRPID ', '# ', 1, 'I', contact(1)%group )/=0) return
541 do rcode=2,n
542 contact(rcode)%ctype = contact(1)%ctype
543 contact(rcode)%group = contact(1)%group
544 contact(rcode)%algtype = contact(1)%algtype
545 end do
546 if( fstr_ctrl_get_data_array_ex( ctrl, data_fmt, cp_name, fcoeff, tpenalty ) /= 0 ) return
547 do rcode=1,n
548 contact(rcode)%pair_name = cp_name(rcode)
549 contact(rcode)%fcoeff = fcoeff(rcode)
550 contact(rcode)%tPenalty = tpenalty(rcode)
551 enddo
552
553 np = 0.d0; tp=0.d0
554 ntol = 0.d0; ttol=0.d0
555 if( fstr_ctrl_get_param_ex( ctrl, 'NPENALTY ', '# ', 0, 'R', np ) /= 0 ) return
556 if( fstr_ctrl_get_param_ex( ctrl, 'TPENALTY ', '# ', 0, 'R', tp ) /= 0 ) return
557 if( fstr_ctrl_get_param_ex( ctrl, 'NTOL ', '# ', 0, 'R', ntol ) /= 0 ) return
558 if( fstr_ctrl_get_param_ex( ctrl, 'TTOL ', '# ', 0, 'R', ttol ) /= 0 ) return
559 fstr_ctrl_get_contact = .true.
560 end function fstr_ctrl_get_contact
561
563 function fstr_ctrl_get_elemopt( ctrl, elemopt361 )
564 integer(kind=kint) :: ctrl
565 integer(kind=kint) :: elemopt361
566 integer(kind=kint) :: fstr_ctrl_get_elemopt
567
568 character(72) :: o361list = 'IC,Bbar '
569
570 integer(kind=kint) :: o361
571
573
574 o361 = elemopt361 + 1
575
576 !* parameter in header line -----------------------------------------------------------------*!
577 if( fstr_ctrl_get_param_ex( ctrl, '361 ', o361list, 0, 'P', o361 ) /= 0) return
578
579 elemopt361 = o361 - 1
580
582
583 end function fstr_ctrl_get_elemopt
584
585
587 function fstr_get_autoinc( ctrl, aincparam )
588 implicit none
589 integer(kind=kint) :: ctrl
590 type( tparamautoinc ) :: aincparam
591 integer(kind=kint) :: fstr_get_autoinc
592
593 integer(kind=kint) :: rcode
594 character(len=HECMW_NAME_LEN) :: data_fmt
595 character(len=128) :: msg
596 integer(kind=kint) :: bound_s(10), bound_l(10)
597 real(kind=kreal) :: rs, rl
598
600
601 bound_s(:) = 0
602 bound_l(:) = 0
603
604 !parameters
605 aincparam%name = ''
606 if( fstr_ctrl_get_param_ex( ctrl, 'NAME ', '# ', 1, 'S', aincparam%name ) /=0 ) return
607
608 !read first line ( decrease criteria )
609 data_fmt = 'riiii '
610 rcode = fstr_ctrl_get_data_ex( ctrl, 1, data_fmt, rs, &
611 & bound_s(1), bound_s(2), bound_s(3), aincparam%NRtimes_s )
612 if( rcode /= 0 ) return
613 aincparam%ainc_Rs = rs
614 aincparam%NRbound_s(knstmaxit) = bound_s(1)
615 aincparam%NRbound_s(knstsumit) = bound_s(2)
616 aincparam%NRbound_s(knstciter) = bound_s(3)
617
618 !read second line ( increase criteria )
619 data_fmt = 'riiii '
620 rcode = fstr_ctrl_get_data_ex( ctrl, 2, data_fmt, rl, &
621 & bound_l(1), bound_l(2), bound_l(3), aincparam%NRtimes_l )
622 if( rcode /= 0 ) return
623 aincparam%ainc_Rl = rl
624 aincparam%NRbound_l(knstmaxit) = bound_l(1)
625 aincparam%NRbound_l(knstsumit) = bound_l(2)
626 aincparam%NRbound_l(knstciter) = bound_l(3)
627
628 !read third line ( cutback criteria )
629 data_fmt = 'ri '
630 rcode = fstr_ctrl_get_data_ex( ctrl, 3, data_fmt, &
631 & aincparam%ainc_Rc, aincparam%CBbound )
632 if( rcode /= 0 ) return
633
634 !input check
635 rcode = 1
636 if( rs<0.d0 .or. rs>1.d0 ) then
637 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : decrease ratio Rs must 0 < Rs < 1.'
638 else if( any(bound_s<0) ) then
639 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : decrease NR bound must >= 0.'
640 else if( aincparam%NRtimes_s < 1 ) then
641 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : # of times to decrease must > 0.'
642 else if( rl<1.d0 ) then
643 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : increase ratio Rl must > 1.'
644 else if( any(bound_l<0) ) then
645 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : increase NR bound must >= 0.'
646 else if( aincparam%NRtimes_l < 1 ) then
647 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : # of times to increase must > 0.'
648 elseif( aincparam%ainc_Rc<0.d0 .or. aincparam%ainc_Rc>1.d0 ) then
649 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : cutback decrease ratio Rc must 0 < Rc < 1.'
650 else if( aincparam%CBbound < 1 ) then
651 write(msg,*) 'fstr contol file error : !AUTOINC_PARAM : maximum # of cutback times must > 0.'
652 else
653 rcode =0
654 end if
655 if( rcode /= 0 ) then
656 write(*,*) trim(msg)
657 write(ilog,*) trim(msg)
658 return
659 endif
660
662 end function fstr_get_autoinc
663
665 function fstr_ctrl_get_timepoints( ctrl, tp )
666 integer(kind=kint) :: ctrl
667 type(time_points) :: tp
668 integer(kind=kint) :: fstr_ctrl_get_timepoints
669
670 integer(kind=kint) :: i, n, rcode
671 logical :: generate
672 real(kind=kreal) :: stime, etime, interval
673
675
676 tp%name = ''
677 if( fstr_ctrl_get_param_ex( ctrl, 'NAME ', '# ', 1, 'S', tp%name ) /=0 ) return
678 tp%range_type = 1
679 if( fstr_ctrl_get_param_ex( ctrl, 'TIME ', 'STEP,TOTAL ', 0, 'P', tp%range_type ) /= 0 ) return
680 generate = .false.
681 if( fstr_ctrl_get_param_ex( ctrl, 'GENERATE ', '# ', 0, 'E', generate ) /= 0) return
682
683 if( generate ) then
684 stime = 0.d0; etime = 0.d0; interval = 1.d0
685 if( fstr_ctrl_get_data_ex( ctrl, 1, 'rrr ', stime, etime, interval ) /= 0) return
686 tp%n_points = int((etime-stime)/interval)+1
687 allocate(tp%points(tp%n_points))
688 do i=1,tp%n_points
689 tp%points(i) = stime + dble(i-1)*interval
690 end do
691 else
692 n = fstr_ctrl_get_data_line_n( ctrl )
693 if( n == 0 ) return
694 tp%n_points = n
695 allocate(tp%points(tp%n_points))
696 if( fstr_ctrl_get_data_array_ex( ctrl, 'r ', tp%points ) /= 0 ) return
697 do i=1,tp%n_points-1
698 if( tp%points(i) < tp%points(i+1) ) cycle
699 write(*,*) 'Error in reading !TIME_POINT: time points must be given in ascending order.'
700 return
701 end do
702 end if
703
705 end function fstr_ctrl_get_timepoints
706
707
708end module fstr_ctrl_common
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 fstr control file data obtaining functions.
integer(kind=kint) function fstr_ctrl_get_contactalgo(ctrl, algo)
Read in !CONTACT.
logical function fstr_ctrl_get_istep(ctrl, hecmesh, steps, tpname, apname)
Read in !STEP and !ISTEP.
integer(kind=kint) function fstr_ctrl_get_solution(ctrl, type, nlgeom)
Read in !SOLUTION.
integer(kind=kint) function fstr_ctrl_get_couple(ctrl, fg_type, fg_first, fg_window, surf_id, surf_id_len)
Read in !COUPLE.
integer(kind=kint) function fstr_get_autoinc(ctrl, aincparam)
Read in !AUTOINC_PARAM !
integer function fstr_ctrl_get_section(ctrl, hecmesh, sections)
Read in !SECTION.
integer(kind=kint) function fstr_ctrl_get_elemopt(ctrl, elemopt361)
Read in !ELEMOPT.
logical function fstr_ctrl_get_contact(ctrl, n, contact, np, tp, ntol, ttol, ctalgo)
Read in contact definition.
integer(kind=kint) function fstr_ctrl_get_timepoints(ctrl, tp)
Read in !TIME_POINTS.
integer(kind=kint) function fstr_ctrl_get_echo(ctrl, echo)
Read in !ECHO.
logical function fstr_ctrl_get_outitem(ctrl, hecmesh, outinfo)
Read in !OUTPUT_RES & !OUTPUT_VIS.
integer(kind=kint) function fstr_ctrl_get_mpc(ctrl, penalty)
Read in !MPC.
integer(kind=kint) function fstr_ctrl_get_write(ctrl, res, visual, femap)
Read in !WRITE.
integer(kind=kint) function fstr_ctrl_get_step(ctrl, amp, iproc)
Read in !STEP.
integer(kind=kint) function fstr_ctrl_get_solver(ctrl, method, precond, nset, iterlog, timelog, steplog, nier, iterpremax, nrest, scaling, dumptype, dumpexit, usejad, ncolor_in, mpc_method, estcond, method2, recyclepre, solver_opt1, solver_opt2, solver_opt3, solver_opt4, solver_opt5, solver_opt6, resid, singma_diag, sigma, thresh, filter)
Read in !SOLVER.
This module contains auxiliary functions in calculation setup.
logical function fstr_str2index(s, x)
subroutine amp_name_to_id(hecmesh, header_name, aname, id)
Definition: hecmw.f90:6
This module defined coomon data and basic structures for analysis.
Definition: m_fstr.f90:15
integer(kind=kint) myrank
PARALLEL EXECUTION.
Definition: m_fstr.f90:80
integer(kind=kint), parameter imsg
Definition: m_fstr.f90:94
integer(kind=kint), parameter kstdynamic
Definition: m_fstr.f90:40
real(kind=kreal) etime
Definition: m_fstr.f90:124
integer(kind=kint), parameter kon
Definition: m_fstr.f90:32
integer(kind=kint), parameter kcaslagrange
contact analysis algorithm
Definition: m_fstr.f90:53
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:91
integer(kind=kint), parameter kststatic
Definition: m_fstr.f90:37
integer(kind=kint), parameter kststaticeigen
Definition: m_fstr.f90:42
This module manages step infomation.
Definition: m_out.f90:6
This module manages step infomation.
Definition: m_step.f90:6
subroutine init_stepinfo(stepinfo)
Initializer.
Definition: m_step.f90:65
integer, parameter stepfixedinc
Definition: m_step.f90:14
integer, parameter stepautoinc
Definition: m_step.f90:15
integer, parameter stepstatic
Definition: m_step.f90:12
This module manages timepoint infomation.
Definition: m_timepoint.f90:6
This module provides functions to calcualte contact stiff matrix.
Definition: fstr_contact.f90:6
Data for section control.
Definition: m_fstr.f90:610
output information
Definition: m_out.f90:17
Step control such as active boundary condition, convergent condition etc.
Definition: m_step.f90:24
Time points storage for output etc.
Definition: m_timepoint.f90:14