15 include
'fstr_ctrl_util_f.inc'
21 subroutine pc_strupr( s )
24 integer :: i, n, a, da
27 da = iachar(
'a') - iachar(
'A')
30 if( a > iachar(
'Z'))
then
35 end subroutine pc_strupr
40 integer(kind=kint) :: ctrl
41 integer(kind=kint) :: type
45 integer(kind=kint) :: ipt
46 character(len=80) :: s
50 s =
'ELEMCHECK,STATIC,EIGEN,HEAT,DYNAMIC,NLSTATIC,STATICEIGEN,NZPROF '
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
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 '
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
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
139 if( method > number_number )
then
140 method = method - number_number
141 if( method > indirect_number )
then
143 method = method - indirect_number + 100
144 if( method == 103 ) method = 101
145 if( method == 105 ) method = 102
148 if( method2 > number_number )
then
149 method2 = method2 - number_number
150 if( method2 > indirect_number )
then
152 method2 = method2 - indirect_number + 100
157 if( dumptype >= 4 )
then
158 dumptype = dumptype - 4
163 if(
fstr_ctrl_get_data_ex( ctrl, 1,
'iiiii ', nier, iterpremax, nrest, ncolor_in, recyclepre )/= 0)
return
166 if( precond == 20 .or. precond == 21)
then
168 else if( precond == 5 )
then
170 & solver_opt4, solver_opt5, solver_opt6 )/= 0)
return
171 else if( method == 101 )
then
189 integer(kind=kint) :: ctrl
190 character(len=HECMW_NAME_LEN) :: amp
191 integer(kind=kint) :: iproc
194 integer(kind=kint) :: ipt = 0
195 integer(kind=kint) :: ip = 0
203 if( ipt == 2 .or. ip == 1 ) iproc = 1
213 integer(kind=kint),
intent(in) :: ctrl
214 type (hecmwst_local_mesh),
intent(in) :: hecmesh
216 character(len=*),
intent(out) :: tpname
217 character(len=*),
intent(out) :: apname
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
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 '
239 steps%initdt = 1.d0/steps%num_substep
247 if( len( trim(amp) )>0 )
then
263 read( ss, * , iostat=ierr ) fn
267 steps%elapsetime = f1
269 steps%mindt = min(f2,steps%initdt)
272 steps%num_substep = max(int((f1+0.999999999d0*fn)/fn),steps%num_substep)
282 if( trim(header_name) ==
'BOUNDARY' )
then
284 else if( trim(header_name) ==
'LOAD' )
then
286 else if( trim(header_name) ==
'CONTACT' )
then
287 contact_n = contact_n+1
288 else if( trim(header_name) ==
'TEMPERATURE' )
then
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) )
302 if( trim(header_name) ==
'BOUNDARY' )
then
304 steps%Boundary(bc_n) = bcid
305 else if( trim(header_name) ==
'LOAD' )
then
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
319 integer(kind=kint),
intent(in) :: ctrl
320 type (hecmwst_local_mesh),
intent(inout) :: hecmesh
321 type (
tsection),
pointer,
intent(inout) :: sections(:)
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 '
331 if( sect_id > hecmesh%section%n_sect )
return
335 if( elemopt > 0 ) sections(sect_id)%elemopt361 = elemopt
338 hecmesh%section%sect_orien_ID(sect_id) = -1
341 if(
associated(g_localcoordsys) )
then
342 k =
size(g_localcoordsys)
345 if( sect_orien == g_localcoordsys(cache)%sys_name )
then
346 hecmesh%section%sect_orien_ID(sect_id) = cache
354 if( sect_orien == g_localcoordsys(j)%sys_name )
then
355 hecmesh%section%sect_orien_ID(sect_id) = j
369 integer(kind=kint) :: ctrl
370 integer(kind=kint) :: res
371 integer(kind=kint) :: visual
372 integer(kind=kint) :: femap
388 integer(kind=kint) :: ctrl
389 integer(kind=kint) :: echo
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
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)),
' '
414 if(
fstr_ctrl_get_param_ex( ctrl,
'TYPE ',
'1,2,3,4,5,6 ', 0,
'I', fg_type )/= 0)
return
418 surf_id_p => surf_id(1)
426 integer(kind=kint),
intent(in) :: ctrl
427 real(kind=kreal),
intent(out) :: penalty
431 if( penalty <= 1.0 )
then
433 write(
imsg,*)
"Warging : !MPC : too small penalty: ", penalty
434 write(*,*)
"Warging : !MPC : too small penalty: ", penalty
444 integer(kind=kint),
intent(in) :: ctrl
445 type (hecmwst_local_mesh),
intent(in) :: hecmesh
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(:)
453 write( ss, * ) hecmw_name_len
454 write( data_fmt,
'(a,a,a,a,a)')
'S', trim(adjustl(ss)),
'S', trim(adjustl(ss)),
' '
459 outinfo%grp_id_name =
"ALL"
467 allocate( header_name(n), onoff(n), vtype(n) )
468 header_name(:) =
""; vtype(:) =
""; onoff(:) =
""
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
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
494 deallocate( header_name, onoff, vtype )
501 integer(kind=kint) :: ctrl
502 integer(kind=kint) :: algo
505 integer(kind=kint) :: rcode
506 character(len=80) :: s
508 s =
'SLAGRANGE,ALAGRANGE '
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
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)
532 write(ss,*) hecmw_name_len
533 write( data_fmt,
'(a,a,a)')
'S', trim(adjustl(ss)),
'Rr '
537 contact(1)%algtype = contactsslid
539 if( contact(1)%algtype==contactglued ) contact(1)%algtype=contactfslid
542 contact(rcode)%ctype = contact(1)%ctype
543 contact(rcode)%group = contact(1)%group
544 contact(rcode)%algtype = contact(1)%algtype
548 contact(rcode)%pair_name = cp_name(rcode)
549 contact(rcode)%fcoeff = fcoeff(rcode)
550 contact(rcode)%tPenalty = tpenalty(rcode)
554 ntol = 0.d0; ttol=0.d0
564 integer(kind=kint) :: ctrl
565 integer(kind=kint) :: elemopt361
568 character(72) :: o361list =
'IC,Bbar '
570 integer(kind=kint) :: o361
574 o361 = elemopt361 + 1
579 elemopt361 = o361 - 1
589 integer(kind=kint) :: ctrl
590 type( tparamautoinc ) :: aincparam
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
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)
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)
631 & aincparam%ainc_Rc, aincparam%CBbound )
632 if( rcode /= 0 )
return
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.'
655 if( rcode /= 0 )
then
657 write(
ilog,*) trim(msg)
666 integer(kind=kint) :: ctrl
670 integer(kind=kint) :: i, n, rcode
672 real(kind=kreal) :: stime,
etime, interval
684 stime = 0.d0;
etime = 0.d0; interval = 1.d0
686 tp%n_points = int((
etime-stime)/interval)+1
687 allocate(tp%points(tp%n_points))
689 tp%points(i) = stime + dble(i-1)*interval
695 allocate(tp%points(tp%n_points))
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.'
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.
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_contactalgo(ctrl, algo)
Read in !CONTACT.
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 !
logical function fstr_ctrl_get_outitem(ctrl, hecMESH, outinfo)
Read in !OUTPUT_RES & !OUTPUT_VIS.
integer(kind=kint) function fstr_ctrl_get_elemopt(ctrl, elemopt361)
Read in !ELEMOPT.
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.
integer(kind=kint) function fstr_ctrl_get_mpc(ctrl, penalty)
Read in !MPC.
integer function fstr_ctrl_get_section(ctrl, hecMESH, sections)
Read in !SECTION.
logical function fstr_ctrl_get_istep(ctrl, hecMESH, steps, tpname, apname)
Read in !STEP and !ISTEP.
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)
This module defined coomon data and basic structures for analysis.
integer(kind=kint) myrank
PARALLEL EXECUTION.
integer(kind=kint), parameter imsg
integer(kind=kint), parameter kstdynamic
integer(kind=kint), parameter kon
integer(kind=kint), parameter kcaslagrange
contact analysis algorithm
integer(kind=kint), parameter ilog
FILE HANDLER.
integer(kind=kint), parameter kststatic
integer(kind=kint), parameter kststaticeigen
This module manages step infomation.
This module manages step infomation.
subroutine init_stepinfo(stepinfo)
Initializer.
integer, parameter stepfixedinc
integer, parameter stepautoinc
integer, parameter stepstatic
This module manages timepoint infomation.
Data for section control.
Step control such as active boundary condition, convergent condition etc.
Time points storage for output etc.