23 include
'fstr_ctrl_util_f.inc'
27 type(hecmwst_local_mesh),
pointer :: mesh
42 subroutine fstr_setup( cntl_filename, hecMESH, fstrPARAM, &
43 fstrSOLID, fstrEIG, fstrHEAT, fstrDYNAMIC, fstrCPL, fstrFREQ )
45 character(len=HECMW_FILENAME_LEN) :: cntl_filename, input_filename
46 type(hecmwst_local_mesh),
target :: hecMESH
55 integer(kind=kint) :: ctrl, ctrl_list(20), ictrl
58 integer,
parameter :: MAXOUTFILE = 10
59 double precision,
parameter :: dpi = 3.14159265358979323846d0
61 external fstr_ctrl_get_c_h_name
62 integer(kind=kint) :: fstr_ctrl_get_c_h_name
64 integer(kind=kint) :: version, resul, visual, femap, n_totlyr
65 integer(kind=kint) :: rcode, n, i, j, cid, nout, nin, ierror
66 character(len=HECMW_NAME_LEN) :: header_name, fname(MAXOUTFILE)
67 real(kind=kreal) :: ee, pp, rho, alpha, thick, alpha_over_mu
68 real(kind=kreal) :: beam_radius, &
69 beam_angle1, beam_angle2, beam_angle3,&
70 beam_angle4, beam_angle5, beam_angle6
74 character(len=HECMW_FILENAME_LEN) :: logfileNAME, mName, mName2
77 integer(kind=kint) :: c_solution, c_solver, c_step, c_write, c_echo
78 integer(kind=kint) :: c_static, c_boundary, c_cload, c_dload, c_temperature, c_reftemp, c_spring
79 integer(kind=kint) :: c_heat, c_fixtemp, c_cflux, c_dflux, c_sflux, c_film, c_sfilm, c_radiate, c_sradiate
80 integer(kind=kint) :: c_eigen, c_contact
81 integer(kind=kint) :: c_dynamic, c_velocity, c_acceleration
82 integer(kind=kint) :: c_fload, c_eigenread
83 integer(kind=kint) :: c_couple, c_material
84 integer(kind=kint) :: c_mpc, c_weldline, c_initial
85 integer(kind=kint) :: c_istep, c_localcoord, c_section
86 integer(kind=kint) :: c_elemopt, c_aincparam, c_timepoints
87 integer(kind=kint) :: c_output, islog
88 integer(kind=kint) :: k
89 integer(kind=kint) :: cache = 1
91 write( logfilename,
'(i5,''.log'')' )
myrank
105 c_solution = 0; c_solver = 0; c_step = 0; c_output = 0; c_echo = 0;
106 c_static = 0; c_boundary = 0; c_cload = 0; c_dload = 0; c_temperature = 0; c_reftemp = 0; c_spring = 0;
107 c_heat = 0; c_fixtemp = 0; c_cflux = 0; c_dflux = 0; c_sflux = 0
108 c_film = 0; c_sfilm = 0; c_radiate= 0; c_sradiate = 0
109 c_eigen = 0; c_contact = 0
110 c_dynamic = 0; c_velocity = 0; c_acceleration = 0
111 c_couple = 0; c_material = 0; c_section =0
112 c_mpc = 0; c_weldline = 0; c_initial = 0
113 c_istep = 0; c_localcoord = 0
114 c_fload = 0; c_eigenread = 0
116 c_aincparam= 0; c_timepoints = 0
122 write(*,*)
'### Error: Cannot open FSTR control file : ', cntl_filename
123 write(
ilog,*)
'### Error: Cannot open FSTR control file : ', cntl_filename
130 if( header_name ==
'!VERSION' )
then
132 else if( header_name ==
'!SOLUTION' )
then
133 c_solution = c_solution + 1
135 else if( header_name ==
'!SOLVER' )
then
136 c_solver = c_solver + 1
138 else if( header_name ==
'!ISTEP' )
then
139 c_istep = c_istep + 1
140 else if( header_name ==
'!STEP' )
then
141 if( version==0 )
then
145 c_istep = c_istep + 1
147 else if( header_name ==
'!WRITE' )
then
149 if( visual==1 ) p%PARAM%fg_visual= 1
150 if( resul==1 ) p%PARAM%fg_result = 1
151 c_output = c_output+1
152 else if( header_name ==
'!ECHO' )
then
155 else if( header_name ==
'!RESTART' )
then
157 fstrsolid%restart_nout= nout
158 fstrdynamic%restart_nout= nout
159 fstrheat%restart_nout= nout
160 else if( header_name ==
'!ORIENTATION' )
then
161 c_localcoord = c_localcoord + 1
162 else if( header_name ==
'!AUTOINC_PARAM' )
then
163 c_aincparam = c_aincparam + 1
164 else if( header_name ==
'!TIME_POINTS' )
then
165 c_timepoints = c_timepoints + 1
166 else if( header_name ==
'!OUTPUT_SSTYPE' )
then
168 else if( header_name ==
'!INITIAL_CONDITION' )
then
169 c_initial = c_initial + 1
173 else if( header_name ==
'!STATIC' )
then
174 c_static = c_static + 1
176 else if( header_name ==
'!BOUNDARY' )
then
177 c_boundary = c_boundary + 1
179 else if( header_name ==
'!CLOAD' )
then
180 c_cload = c_cload + 1
183 else if( header_name ==
'!DLOAD' )
then
184 c_dload = c_dload + 1
186 else if( header_name ==
'!CONTACT_ALGO' )
then
188 else if( header_name ==
'!CONTACT' )
then
190 c_contact = c_contact + n
191 else if( header_name ==
'!MATERIAL' )
then
192 c_material = c_material + 1
193 else if( header_name ==
'!TEMPERATURE' )
then
194 c_temperature = c_temperature + 1
196 else if( header_name ==
'!SPRING' )
then
197 c_spring = c_spring + 1
199 else if( header_name ==
'!REFTEMP' )
then
200 c_reftemp = c_reftemp + 1
205 else if( header_name ==
'!HEAT' )
then
207 else if( header_name ==
'!FIXTEMP' )
then
208 c_fixtemp = c_fixtemp + 1
210 else if( header_name ==
'!CFLUX' )
then
211 c_cflux = c_cflux + 1
213 else if( header_name ==
'!DFLUX' )
then
214 c_dflux = c_dflux + 1
216 else if( header_name ==
'!SFLUX' )
then
217 c_sflux = c_sflux + 1
219 else if( header_name ==
'!FILM' )
then
222 else if( header_name ==
'!SFILM' )
then
223 c_sfilm = c_sfilm + 1
225 else if( header_name ==
'!RADIATE' )
then
226 c_radiate = c_radiate + 1
228 else if( header_name ==
'!SRADIATE' )
then
229 c_sradiate = c_sradiate + 1
231 else if( header_name ==
'!WELD_LINE' )
then
232 c_weldline = c_weldline + 1
236 else if( header_name ==
'!EIGEN' )
then
237 c_eigen = c_eigen + 1
242 else if( header_name ==
'!DYNAMIC' )
then
243 c_dynamic = c_dynamic + 1
245 else if( header_name ==
'!VELOCITY' )
then
246 c_velocity = c_velocity + 1
248 else if( header_name ==
'!ACCELERATION' )
then
249 c_acceleration = c_acceleration + 1
251 else if( header_name ==
'!FLOAD' )
then
252 c_fload = c_fload + 1
254 else if( header_name ==
'!EIGENREAD' )
then
255 c_eigenread = c_eigenread + 1
260 else if( header_name ==
'!COUPLE' )
then
261 c_couple = c_couple + 1
266 else if( header_name ==
'!MPC' )
then
272 else if( header_name ==
'!INCLUDE' )
then
273 ctrl_list(ictrl) = ctrl
278 write(*,*)
'### Error: Cannot open FSTR control file : ', input_filename
279 write(
ilog,*)
'### Error: Cannot open FSTR control file : ', input_filename
287 else if( header_name ==
'!END' )
then
298 ctrl = ctrl_list(ictrl)
305 if( c_contact>0 )
then
306 allocate( fstrsolid%contacts( c_contact ) )
310 if( c_weldline>0 )
allocate( fstrheat%weldline( c_weldline ) )
312 if( c_istep>0 )
allocate( fstrsolid%step_ctrl( c_istep ) )
313 if( c_localcoord>0 )
allocate( g_localcoordsys(c_localcoord) )
314 allocate( fstrparam%ainc(0:c_aincparam) )
318 if( c_timepoints>0 )
allocate( fstrparam%timepoints(c_timepoints) )
320 p%SOLID%is_33shell = 0
321 p%SOLID%is_33beam = 0
323 do i=1,hecmesh%n_elem_type
324 n = hecmesh%elem_type_item(i)
325 if (n == 781 .or. n == 761)
then
326 p%SOLID%is_33shell = 1
327 elseif (n == 641)
then
328 p%SOLID%is_33beam = 1
333 if( hecmesh%material%n_mat>n ) n= hecmesh%material%n_mat
334 if( n==0 ) stop
"material property not defined!"
335 allocate( fstrsolid%materials( n ) )
339 if( hecmesh%section%n_sect >0 )
then
340 do i=1,hecmesh%section%n_sect
341 if( hecmesh%section%sect_type(i) == 4 ) cycle
342 cid = hecmesh%section%sect_mat_ID_item(i)
343 if( cid>n ) stop
"Error in material property definition!"
344 if( fstrparam%nlgeom .or. fstrparam%solution_type==
kststaticeigen ) &
345 fstrsolid%materials(cid)%nlgeom_flag = 1
348 n_totlyr,alpha_over_mu, &
349 beam_radius,beam_angle1,beam_angle2,beam_angle3, &
350 beam_angle4,beam_angle5,beam_angle6)
351 fstrsolid%materials(cid)%name = hecmesh%material%mat_name(cid)
352 fstrsolid%materials(cid)%variables(
m_youngs)=ee
353 fstrsolid%materials(cid)%variables(
m_poisson)=pp
354 fstrsolid%materials(cid)%variables(
m_density)=rho
355 fstrsolid%materials(cid)%variables(
m_exapnsion)=alpha
356 fstrsolid%materials(cid)%variables(
m_thick)=thick
358 fstrsolid%materials(cid)%variables(
m_beam_radius)=beam_radius
359 fstrsolid%materials(cid)%variables(
m_beam_angle1)=beam_angle1
360 fstrsolid%materials(cid)%variables(
m_beam_angle2)=beam_angle2
361 fstrsolid%materials(cid)%variables(
m_beam_angle3)=beam_angle3
362 fstrsolid%materials(cid)%variables(
m_beam_angle4)=beam_angle4
363 fstrsolid%materials(cid)%variables(
m_beam_angle5)=beam_angle5
364 fstrsolid%materials(cid)%variables(
m_beam_angle6)=beam_angle6
365 fstrsolid%materials(cid)%mtype =
elastic
366 fstrsolid%materials(cid)%totallyr = n_totlyr
367 fstrsolid%materials(cid)%shell_var => shmat
372 allocate( fstrsolid%sections(hecmesh%section%n_sect) )
373 do i=1,hecmesh%section%n_sect
376 if( p%PARAM%nlgeom )
then
379 fstrsolid%sections(i)%elemopt361 =
kel361ic
381 else if( p%PARAM%solution_type==
ksteigen )
then
382 fstrsolid%sections(i)%elemopt361 =
kel361ic
386 fstrsolid%sections(i)%elemopt361 =
kel361fi
390 allocate( fstrsolid%output_ctrl( 4 ) )
392 fstrsolid%output_ctrl( 1 )%filename = trim(logfilename)
393 fstrsolid%output_ctrl( 1 )%filenum =
ilog
413 fstrsolid%elemopt361 = 0
414 fstrsolid%AutoINC_stat = 0
415 fstrsolid%CutBack_stat = 0
416 fstrsolid%NRstat_i(:) = 0
417 fstrsolid%NRstat_r(:) = 0.d0
422 if( header_name ==
'!ORIENTATION' )
then
423 c_localcoord = c_localcoord + 1
425 write(*,*)
'### Error: Fail in read in ORIENTATION definition : ', c_localcoord
426 write(
ilog,*)
'### Error: Fail in read in ORIENTATION definition : ', c_localcoord
431 elseif( header_name ==
'!CONTACT' )
then
434 ,ee, pp, rho, alpha, p%PARAM%contact_algo ) )
then
435 write(*,*)
'### Error: Fail in read in contact condition : ', c_contact
436 write(
ilog,*)
'### Error: Fail in read in contact condition : ', c_contact
440 if( ee>0.d0 )
cdotp = ee
441 if( pp>0.d0 )
mut = pp
442 if( rho>0.d0 )
cgn = rho
443 if( alpha>0.d0 )
cgt = alpha
445 if( .not. fstr_contact_check( fstrsolid%contacts(c_contact+i), p%MESH ) )
then
446 write(*,*)
'### Error: Inconsistence in contact and surface definition : ' , i+c_contact
447 write(
ilog,*)
'### Error: Inconsistence in contact and surface definition : ', i+c_contact
451 isok = fstr_contact_init( fstrsolid%contacts(c_contact+i), p%MESH,
myrank)
453 isok = fstr_contact_init( fstrsolid%contacts(c_contact+i), p%MESH)
458 c_contact = c_contact+n
460 else if( header_name ==
'!ISTEP' )
then
462 if( .not.
fstr_ctrl_get_istep( ctrl, hecmesh, fstrsolid%step_ctrl(c_istep), mname, mname2 ) )
then
463 write(*,*)
'### Error: Fail in read in step definition : ' , c_istep
464 write(
ilog,*)
'### Error: Fail in read in step definition : ', c_istep
467 if(
associated(fstrparam%timepoints) )
then
468 do i=1,
size(fstrparam%timepoints)
469 if(
fstr_streqr( fstrparam%timepoints(i)%name, mname ) )
then
470 fstrsolid%step_ctrl(c_istep)%timepoint_id = i;
exit
474 if(
associated(fstrparam%ainc) )
then
475 do i=1,
size(fstrparam%ainc)
476 if(
fstr_streqr( fstrparam%ainc(i)%name, mname2 ) )
then
477 fstrsolid%step_ctrl(c_istep)%AincParam_id = i;
exit
481 else if( header_name ==
'!STEP' .and. version>=1 )
then
483 if( .not.
fstr_ctrl_get_istep( ctrl, hecmesh, fstrsolid%step_ctrl(c_istep), mname, mname2 ) )
then
484 write(*,*)
'### Error: Fail in read in step definition : ' , c_istep
485 write(
ilog,*)
'### Error: Fail in read in step definition : ', c_istep
488 if(
associated(fstrparam%timepoints) )
then
489 do i=1,
size(fstrparam%timepoints)
490 if(
fstr_streqr( fstrparam%timepoints(i)%name, mname ) )
then
491 fstrsolid%step_ctrl(c_istep)%timepoint_id = i;
exit
495 if(
associated(fstrparam%ainc) )
then
496 do i=1,
size(fstrparam%ainc)-1
497 if(
fstr_streqr( fstrparam%ainc(i)%name, mname2 ) )
then
498 fstrsolid%step_ctrl(c_istep)%AincParam_id = i;
exit
503 else if( header_name ==
'!HEAT' )
then
507 else if( header_name ==
'!WELD_LINE' )
then
508 fstrheat%WL_tot = fstrheat%WL_tot+1
510 write(*,*)
'### Error: Fail in read in Weld Line definition : ' , fstrheat%WL_tot
511 write(
ilog,*)
'### Error: Fail in read in Weld Line definition : ', fstrheat%WL_tot
515 else if( header_name ==
'!INITIAL_CONDITION' .or. header_name ==
'!INITIAL CONDITION' )
then
516 c_initial = c_initial+1
518 write(*,*)
'### Error: Fail in read in INITIAL CONDITION definition : ' ,c_initial
519 write(
ilog,*)
'### Error: Fail in read in INITIAL CONDITION definition : ', c_initial
523 else if( header_name ==
'!SECTION' )
then
524 c_section = c_section+1
526 write(*,*)
'### Error: Fail in read in SECTION definition : ' , c_section
527 write(
ilog,*)
'### Error: Fail in read in SECTION definition : ', c_section
531 else if( header_name ==
'!ELEMOPT' )
then
532 c_elemopt = c_elemopt+1
534 write(*,*)
'### Error: Fail in read in ELEMOPT definition : ' , c_elemopt
535 write(
ilog,*)
'### Error: Fail in read in ELEMOPT definition : ', c_elemopt
540 else if( header_name ==
'!MATERIAL' )
then
541 c_material = c_material+1
543 write(*,*)
'### Error: Fail in read in material definition : ' , c_material
544 write(
ilog,*)
'### Error: Fail in read in material definition : ', c_material
548 if(cache < hecmesh%material%n_mat)
then
549 if(
fstr_streqr( hecmesh%material%mat_name(cache), mname ))
then
555 do i=1,hecmesh%material%n_mat
556 if(
fstr_streqr( hecmesh%material%mat_name(i), mname ) )
then
564 write(*,*)
'### Error: Fail in read in material definition : ' , c_material
565 write(
ilog,*)
'### Error: Fail in read in material definition : ', c_material
568 fstrsolid%materials(cid)%name = mname
569 if(c_material>hecmesh%material%n_mat)
call initmaterial( fstrsolid%materials(cid) )
571 else if( header_name ==
'!ELASTIC' )
then
572 if( c_material >0 )
then
574 fstrsolid%materials(cid)%mtype, &
575 fstrsolid%materials(cid)%nlgeom_flag, &
576 fstrsolid%materials(cid)%variables, &
577 fstrsolid%materials(cid)%dict)/=0 )
then
578 write(*,*)
'### Error: Fail in read in elasticity definition : ' , cid
579 write(
ilog,*)
'### Error: Fail in read in elasticity definition : ', cid
583 else if( header_name ==
'!PLASTIC' )
then
586 fstrsolid%materials(cid)%mtype, &
587 fstrsolid%materials(cid)%nlgeom_flag, &
588 fstrsolid%materials(cid)%variables, &
589 fstrsolid%materials(cid)%table, &
590 fstrsolid%materials(cid)%dict)/=0 )
then
591 write(*,*)
'### Error: Fail in read in plasticity definition : ' , cid
592 write(
ilog,*)
'### Error: Fail in read in plasticity definition : ', cid
596 else if( header_name ==
'!HYPERELASTIC' )
then
599 fstrsolid%materials(cid)%mtype, &
600 fstrsolid%materials(cid)%nlgeom_flag, &
601 fstrsolid%materials(cid)%variables )/=0 )
then
602 write(*,*)
'### Error: Fail in read in elasticity definition : ' , cid
603 write(
ilog,*)
'### Error: Fail in read in elasticity definition : ', cid
607 else if( header_name ==
'!VISCOELASTIC' )
then
610 fstrsolid%materials(cid)%mtype, &
611 fstrsolid%materials(cid)%nlgeom_flag, &
612 fstrsolid%materials(cid)%dict)/=0 )
then
613 write(*,*)
'### Error: Fail in read in plasticity definition : ' , cid
614 write(
ilog,*)
'### Error: Fail in read in plasticity definition : ', cid
618 else if( header_name ==
'!TRS' )
then
621 write(*,*)
'### WARNING: TRS can only be defined for viscoelastic material! It is ignored! '
622 write(
ilog,*)
'### WARNING: TRS can only be defined for viscoelastic material! It is ignored! '
624 if(
fstr_ctrl_get_trs( ctrl, fstrsolid%materials(cid)%mtype, fstrsolid%materials(cid)%variables)/=0 )
then
625 write(*,*)
'### Error: Fail in read in TRS definition : ' , cid
626 write(
ilog,*)
'### Error: Fail in read in TRS definition : ', cid
631 else if( header_name ==
'!CREEP' )
then
634 fstrsolid%materials(cid)%mtype, &
635 fstrsolid%materials(cid)%nlgeom_flag, &
636 fstrsolid%materials(cid)%dict)/=0 )
then
637 write(*,*)
'### Error: Fail in read in plasticity definition : ' , cid
638 write(
ilog,*)
'### Error: Fail in read in plasticity definition : ', cid
642 else if( header_name ==
'!DENSITY' )
then
645 write(*,*)
'### Error: Fail in read in density definition : ' , cid
646 write(
ilog,*)
'### Error: Fail in read in density definition : ', cid
650 else if( header_name ==
'!EXPANSION_COEF' .or. header_name ==
'!EXPANSION_COEFF' .or. &
651 header_name ==
'!EXPANSION')
then
654 fstrsolid%materials(cid)%dict)/=0 )
then
655 write(*,*)
'### Error: Fail in read in expansion coefficient definition : ' , cid
656 write(
ilog,*)
'### Error: Fail in read in expansion coefficient definition : ', cid
660 else if( header_name ==
'!FLUID' )
then
661 if( c_material >0 )
then
663 fstrsolid%materials(cid)%mtype, &
664 fstrsolid%materials(cid)%nlgeom_flag, &
665 fstrsolid%materials(cid)%variables, &
666 fstrsolid%materials(cid)%dict)/=0 )
then
667 write(*,*)
'### Error: Fail in read in fluid definition : ' , cid
668 write(
ilog,*)
'### Error: Fail in read in fluid definition : ', cid
672 else if( header_name ==
'!USER_MATERIAL' )
then
675 fstrsolid%materials(cid)%nlgeom_flag, fstrsolid%materials(cid)%nfstatus, &
676 fstrsolid%materials(cid)%variables(101:) )/=0 )
then
677 write(*,*)
'### Error: Fail in read in user defined material : ' , cid
678 write(
ilog,*)
'### Error: Fail in read in user defined material : ', cid
685 else if( header_name ==
'!WRITE' )
then
687 if( islog == 1 )
then
689 outctrl%filename = trim(logfilename)
690 outctrl%filenum =
ilog
693 if( femap == 1 )
then
695 write( outctrl%filename, *)
'utable.',
myrank,
".dat"
696 outctrl%filenum =
iutb
698 open( unit=outctrl%filenum, file=outctrl%filename, status=
'REPLACE' )
700 if( resul == 1 )
then
704 if( visual == 1 )
then
709 else if( header_name ==
'!OUTPUT_RES' )
then
712 write(*,*)
'### Error: Fail in read in node output definition : ' , c_output
713 write(
ilog,*)
'### Error: Fail in read in node output definition : ', c_output
716 if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name /=
'ALL' )
then
718 do i=1,hecmesh%node_group%n_grp
719 if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name == hecmesh%node_group%grp_name(i) )
then
720 fstrsolid%output_ctrl(c_output)%outinfo%grp_id = i;
exit
724 else if( header_name ==
'!OUTPUT_VIS' )
then
727 write(*,*)
'### Error: Fail in read in element output definition : ' , c_output
728 write(
ilog,*)
'### Error: Fail in read in element output definition : ', c_output
731 if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name /=
'ALL' )
then
733 do i=1,hecmesh%node_group%n_grp
734 if( fstrsolid%output_ctrl(c_output)%outinfo%grp_id_name == hecmesh%node_group%grp_name(i) )
then
735 fstrsolid%output_ctrl(c_output)%outinfo%grp_id = i;
exit
739 else if( header_name ==
'!AUTOINC_PARAM' )
then
740 c_aincparam = c_aincparam + 1
742 write(*,*)
'### Error: Fail in read in AUTOINC_PARAM definition : ' , c_aincparam
743 write(
ilog,*)
'### Error: Fail in read in AUTOINC_PARAM definition : ', c_aincparam
746 else if( header_name ==
'!TIME_POINTS' )
then
747 c_timepoints = c_timepoints + 1
749 write(*,*)
'### Error: Fail in read in TIME_POINTS definition : ' , c_timepoints
750 write(
ilog,*)
'### Error: Fail in read in TIME_POINTS definition : ', c_timepoints
753 else if( header_name ==
'!ULOAD' )
then
755 write(*,*)
'### Error: Fail in read in ULOAD definition : '
756 write(
ilog,*)
'### Error: Fail in read in ULOAD definition : '
760 else if( header_name ==
'!INCLUDE' )
then
761 ctrl_list(ictrl) = ctrl
766 write(*,*)
'### Error: Cannot open FSTR control file : ', input_filename
767 write(
ilog,*)
'### Error: Cannot open FSTR control file : ', input_filename
773 else if( header_name ==
'!END' )
then
784 ctrl = ctrl_list(ictrl)
792 if( .not. p%PARAM%nlgeom )
then
794 fstrsolid%materials(i)%nlgeom_flag = 0
798 if( fstrsolid%TEMP_ngrp_tot > 0 .or. fstrsolid%TEMP_irres > 0 )
then
799 allocate ( fstrsolid%temperature( hecmesh%n_node ) ,stat=ierror )
800 if( ierror /= 0 )
then
801 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, TEMPERATURE>'
802 write(
idbg,*)
' rank = ',
myrank,
' ierror = ',ierror
804 call hecmw_abort( hecmw_comm_get_comm())
807 allocate ( fstrsolid%last_temp( hecmesh%n_node ) ,stat=ierror )
808 if( ierror /= 0 )
then
809 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, LAST_TEMP>'
810 write(
idbg,*)
' rank = ',
myrank,
' ierror = ',ierror
812 call hecmw_abort( hecmw_comm_get_comm())
814 fstrsolid%last_temp = 0.d0
815 allocate ( fstrsolid%temp_bak( hecmesh%n_node ) ,stat=ierror )
816 if( ierror /= 0 )
then
817 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, TEMP_BAK>'
818 write(
idbg,*)
' rank = ',
myrank,
' ierror = ',ierror
820 call hecmw_abort( hecmw_comm_get_comm())
822 fstrsolid%temp_bak = 0.d0
825 if(
associated(fstrsolid%step_ctrl) )
then
826 fstrsolid%nstep_tot =
size(fstrsolid%step_ctrl)
830 if( p%PARAM%solution_type==
kststatic .and. p%PARAM%nlgeom )
then
831 write( *,* )
" ERROR: STEP not defined!"
832 write(
idbg,* )
"ERROR: STEP not defined!"
834 call hecmw_abort( hecmw_comm_get_comm())
837 if(
myrank==0 )
write(*,*)
"Step control not defined! Using default step=1"
838 fstrsolid%nstep_tot = 1
839 allocate( fstrsolid%step_ctrl(1) )
841 n = fstrsolid%BOUNDARY_ngrp_tot
842 if( n>0 )
allocate( fstrsolid%step_ctrl(1)%Boundary(n) )
844 fstrsolid%step_ctrl(1)%Boundary(i) = fstrsolid%BOUNDARY_ngrp_GRPID(i)
846 n = fstrsolid%CLOAD_ngrp_tot + fstrsolid%DLOAD_ngrp_tot + fstrsolid%TEMP_ngrp_tot + fstrsolid%SPRING_ngrp_tot
847 if( n>0 )
allocate( fstrsolid%step_ctrl(1)%Load(n) )
849 do i = 1, fstrsolid%CLOAD_ngrp_tot
851 fstrsolid%step_ctrl(1)%Load(n) = fstrsolid%CLOAD_ngrp_GRPID(i)
853 do i = 1, fstrsolid%DLOAD_ngrp_tot
855 fstrsolid%step_ctrl(1)%Load(n) = fstrsolid%DLOAD_ngrp_GRPID(i)
857 do i = 1, fstrsolid%TEMP_ngrp_tot
859 fstrsolid%step_ctrl(1)%Load(n) = fstrsolid%TEMP_ngrp_GRPID(i)
861 do i = 1, fstrsolid%SPRING_ngrp_tot
863 fstrsolid%step_ctrl(1)%Load(n) = fstrsolid%SPRING_ngrp_GRPID(i)
872 if( p%PARAM%solution_type ==
kstheat)
then
873 p%PARAM%fg_irres = fstrsolid%output_ctrl(3)%freqency
874 p%PARAM%fg_iwres = fstrsolid%output_ctrl(4)%freqency
878 do i=1,hecmesh%section%n_sect
879 cid = hecmesh%section%sect_mat_ID_item(i)
880 n = fstrsolid%materials(cid)%totallyr
881 if (n > n_totlyr)
then
885 p%SOLID%max_lyr = n_totlyr
896 type(hecmwst_local_mesh),
target :: hecMESH
899 integer :: ndof, ntotal, ierror, ic_type
903 fstrsolid%BOUNDARY_ngrp_tot = 0
904 fstrsolid%BOUNDARY_ngrp_rot = 0
905 fstrsolid%CLOAD_ngrp_tot = 0
906 fstrsolid%CLOAD_ngrp_rot = 0
907 fstrsolid%DLOAD_ngrp_tot = 0
908 fstrsolid%DLOAD_follow = 1
909 fstrsolid%TEMP_ngrp_tot = 0
910 fstrsolid%SPRING_ngrp_tot = 0
911 fstrsolid%TEMP_irres = 0
912 fstrsolid%TEMP_tstep = 1
913 fstrsolid%TEMP_interval = 1
914 fstrsolid%TEMP_rtype = 1
915 fstrsolid%TEMP_factor = 1.d0
916 fstrsolid%VELOCITY_ngrp_tot = 0
917 fstrsolid%ACCELERATION_ngrp_tot = 0
918 fstrsolid%COUPLE_ngrp_tot = 0
920 fstrsolid%restart_nout= 0
927 type(hecmwst_local_mesh),
target :: hecMESH
930 integer :: ndof, ntotal, ierror, ic_type
933 ntotal=ndof*hecmesh%n_node
935 allocate ( fstrsolid%GL( ntotal ) ,stat=ierror )
936 if( ierror /= 0 )
then
937 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, GL>'
938 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
940 call hecmw_abort( hecmw_comm_get_comm())
942 allocate ( fstrsolid%EFORCE( ntotal ) ,stat=ierror )
943 if( ierror /= 0 )
then
944 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, EFORCE>'
945 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
947 call hecmw_abort( hecmw_comm_get_comm())
956 allocate ( fstrsolid%unode( ntotal ) ,stat=ierror )
957 if( ierror /= 0 )
then
958 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, unode>'
959 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
961 call hecmw_abort( hecmw_comm_get_comm())
963 allocate ( fstrsolid%dunode( ntotal ) ,stat=ierror )
964 if( ierror /= 0 )
then
965 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, dunode>'
966 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
968 call hecmw_abort( hecmw_comm_get_comm())
970 allocate ( fstrsolid%ddunode( ntotal ) ,stat=ierror )
971 if( ierror /= 0 )
then
972 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, ddunode>'
973 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
975 call hecmw_abort( hecmw_comm_get_comm())
977 allocate ( fstrsolid%QFORCE( ntotal ) ,stat=ierror )
978 if( ierror /= 0 )
then
979 write(
idbg,*)
'stop due to allocation error <FSTR_SOLID, QFORCE>'
980 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
982 call hecmw_abort( hecmw_comm_get_comm())
987 fstrsolid%unode(:) = 0.d0
988 fstrsolid%dunode(:) = 0.d0
989 fstrsolid%ddunode(:) = 0.d0
990 fstrsolid%QFORCE(:) = 0.d0
991 fstrsolid%FACTOR( 1:2 ) = 0.d0
994 fstrsolid%n_fix_mpc = hecmesh%mpc%n_mpc
995 if( fstrsolid%n_fix_mpc>0 )
then
996 allocate( fstrsolid%mpc_const( fstrsolid%n_fix_mpc ) )
997 fstrsolid%mpc_const(:) = hecmesh%mpc%mpc_const(:)
1001 fstrsolid%FACTOR(2)=1.d0
1002 fstrsolid%FACTOR(1)=0.d0
1010 type(hecmwst_local_mesh),
target :: hecMESH
1013 integer :: i, j, ng, isect, ndof, id, nn
1015 if( hecmesh%n_elem <=0 )
then
1016 stop
"no element defined!"
1019 fstrsolid%maxn_gauss = 0
1021 allocate( fstrsolid%elements(hecmesh%n_elem) )
1022 do i=1,hecmesh%n_elem
1023 fstrsolid%elements(i)%etype = hecmesh%elem_type(i)
1024 if( hecmesh%elem_type(i)==301 ) fstrsolid%elements(i)%etype=111
1025 if (hecmw_is_etype_link(fstrsolid%elements(i)%etype)) cycle
1026 if (hecmw_is_etype_patch(fstrsolid%elements(i)%etype)) cycle
1028 if( ng > fstrsolid%maxn_gauss ) fstrsolid%maxn_gauss = ng
1029 if(ng>0)
allocate( fstrsolid%elements(i)%gausses( ng ) )
1031 isect= hecmesh%section_ID(i)
1034 id=hecmesh%section%sect_opt(isect)
1036 fstrsolid%elements(i)%iset=1
1037 else if( id==1)
then
1038 fstrsolid%elements(i)%iset=0
1039 else if( id==2)
then
1040 fstrsolid%elements(i)%iset=2
1044 if( isect<0 .or. isect>hecmesh%section%n_sect ) &
1045 stop
"Error in element's section definition"
1046 id = hecmesh%section%sect_mat_ID_item(isect)
1047 fstrsolid%materials(id)%cdsys_ID = hecmesh%section%sect_orien_ID(isect)
1049 fstrsolid%elements(i)%gausses(j)%pMaterial => fstrsolid%materials(id)
1053 nn = hecmw_get_max_node(hecmesh%elem_type(i))
1054 allocate(fstrsolid%elements(i)%equiForces(nn*ndof))
1055 fstrsolid%elements(i)%equiForces = 0.0d0
1057 if( hecmesh%elem_type(i)==361 )
then
1058 if( fstrsolid%sections(isect)%elemopt361==
kel361ic )
then
1059 allocate( fstrsolid%elements(i)%aux(3,3) )
1060 fstrsolid%elements(i)%aux = 0.0d0
1065 call hecmw_allreduce_i1(hecmesh,fstrsolid%maxn_gauss,hecmw_max)
1071 integer :: i, j, ierror
1072 if(
associated(fstrsolid%materials) )
then
1073 do j=1,
size(fstrsolid%materials)
1074 call finalizematerial(fstrsolid%materials(j))
1076 deallocate( fstrsolid%materials )
1078 if( .not.
associated(fstrsolid%elements ) )
return
1079 do i=1,
size(fstrsolid%elements)
1080 if(
associated(fstrsolid%elements(i)%gausses) )
then
1081 do j=1,
size(fstrsolid%elements(i)%gausses)
1082 call fstr_finalize_gauss(fstrsolid%elements(i)%gausses(j))
1084 deallocate( fstrsolid%elements(i)%gausses )
1086 if(
associated(fstrsolid%elements(i)%equiForces) )
then
1087 deallocate(fstrsolid%elements(i)%equiForces)
1089 if(
associated(fstrsolid%elements(i)%aux) )
then
1090 deallocate(fstrsolid%elements(i)%aux)
1094 deallocate( fstrsolid%elements )
1095 if(
associated( fstrsolid%mpc_const ) )
then
1096 deallocate( fstrsolid%mpc_const )
1099 if(
associated(fstrsolid%step_ctrl) )
then
1100 do i=1,
size(fstrsolid%step_ctrl)
1103 deallocate( fstrsolid%step_ctrl )
1105 if(
associated(fstrsolid%output_ctrl) )
then
1106 do i=1,
size(fstrsolid%output_ctrl)
1107 if( fstrsolid%output_ctrl(i)%filenum==
iutb ) &
1108 close(fstrsolid%output_ctrl(i)%filenum)
1110 deallocate(fstrsolid%output_ctrl)
1112 if(
associated( fstrsolid%sections ) )
then
1113 deallocate( fstrsolid%sections )
1116 if(
associated(fstrsolid%GL) )
then
1117 deallocate(fstrsolid%GL ,stat=ierror)
1118 if( ierror /= 0 )
then
1119 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, GL>'
1121 call hecmw_abort( hecmw_comm_get_comm())
1124 if(
associated(fstrsolid%EFORCE) )
then
1125 deallocate(fstrsolid%EFORCE ,stat=ierror)
1126 if( ierror /= 0 )
then
1127 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, EFORCE>'
1129 call hecmw_abort( hecmw_comm_get_comm())
1132 if(
associated(fstrsolid%unode) )
then
1133 deallocate(fstrsolid%unode ,stat=ierror)
1134 if( ierror /= 0 )
then
1135 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, unode>'
1137 call hecmw_abort( hecmw_comm_get_comm())
1140 if(
associated(fstrsolid%dunode) )
then
1141 deallocate(fstrsolid%dunode ,stat=ierror)
1142 if( ierror /= 0 )
then
1143 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, dunode>'
1145 call hecmw_abort( hecmw_comm_get_comm())
1148 if(
associated(fstrsolid%ddunode) )
then
1149 deallocate(fstrsolid%ddunode ,stat=ierror)
1150 if( ierror /= 0 )
then
1151 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, ddunode>'
1153 call hecmw_abort( hecmw_comm_get_comm())
1156 if(
associated(fstrsolid%QFORCE) )
then
1157 deallocate(fstrsolid%QFORCE ,stat=ierror)
1158 if( ierror /= 0 )
then
1159 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, QFORCE>'
1161 call hecmw_abort( hecmw_comm_get_comm())
1164 if(
associated(fstrsolid%temperature) )
then
1165 deallocate(fstrsolid%temperature ,stat=ierror)
1166 if( ierror /= 0 )
then
1167 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, temperature>'
1169 call hecmw_abort( hecmw_comm_get_comm())
1172 if(
associated(fstrsolid%last_temp) )
then
1173 deallocate(fstrsolid%last_temp ,stat=ierror)
1174 if( ierror /= 0 )
then
1175 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, reftemp>'
1177 call hecmw_abort( hecmw_comm_get_comm())
1180 if(
associated(fstrsolid%temp_bak) )
then
1181 deallocate(fstrsolid%temp_bak ,stat=ierror)
1182 if( ierror /= 0 )
then
1183 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, reftemp>'
1185 call hecmw_abort( hecmw_comm_get_comm())
1190 if(
associated(fstrsolid%BOUNDARY_ngrp_GRPID) )
then
1191 deallocate(fstrsolid%BOUNDARY_ngrp_GRPID, stat=ierror)
1192 if( ierror /= 0 )
then
1193 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_GRPID>'
1195 call hecmw_abort( hecmw_comm_get_comm())
1198 if(
associated(fstrsolid%BOUNDARY_ngrp_ID) )
then
1199 deallocate(fstrsolid%BOUNDARY_ngrp_ID, stat=ierror)
1200 if( ierror /= 0 )
then
1201 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_ID>'
1203 call hecmw_abort( hecmw_comm_get_comm())
1206 if(
associated(fstrsolid%BOUNDARY_ngrp_type) )
then
1207 deallocate(fstrsolid%BOUNDARY_ngrp_type, stat=ierror)
1208 if( ierror /= 0 )
then
1209 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_type>'
1211 call hecmw_abort( hecmw_comm_get_comm())
1214 if(
associated(fstrsolid%BOUNDARY_ngrp_val) )
then
1215 deallocate(fstrsolid%BOUNDARY_ngrp_val, stat=ierror)
1216 if( ierror /= 0 )
then
1217 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_val>'
1219 call hecmw_abort( hecmw_comm_get_comm())
1222 if(
associated(fstrsolid%BOUNDARY_ngrp_amp) )
then
1223 deallocate(fstrsolid%BOUNDARY_ngrp_amp, stat=ierror)
1224 if( ierror /= 0 )
then
1225 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_amp>'
1227 call hecmw_abort( hecmw_comm_get_comm())
1230 if(
associated(fstrsolid%BOUNDARY_ngrp_rotID) )
then
1231 deallocate(fstrsolid%BOUNDARY_ngrp_rotID, stat=ierror)
1232 if( ierror /= 0 )
then
1233 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_rotID>'
1235 call hecmw_abort( hecmw_comm_get_comm())
1238 if(
associated(fstrsolid%BOUNDARY_ngrp_centerID) )
then
1239 deallocate(fstrsolid%BOUNDARY_ngrp_centerID, stat=ierror)
1240 if( ierror /= 0 )
then
1241 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, BOUNDARY_ngrp_centerID>'
1243 call hecmw_abort( hecmw_comm_get_comm())
1248 if(
associated(fstrsolid%CLOAD_ngrp_GRPID) )
then
1249 deallocate(fstrsolid%CLOAD_ngrp_GRPID, stat=ierror)
1250 if( ierror /= 0 )
then
1251 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_GRPID>'
1253 call hecmw_abort( hecmw_comm_get_comm())
1256 if(
associated(fstrsolid%CLOAD_ngrp_ID) )
then
1257 deallocate(fstrsolid%CLOAD_ngrp_ID, stat=ierror)
1258 if( ierror /= 0 )
then
1259 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_ID>'
1261 call hecmw_abort( hecmw_comm_get_comm())
1264 if(
associated(fstrsolid%CLOAD_ngrp_DOF) )
then
1265 deallocate(fstrsolid%CLOAD_ngrp_DOF, stat=ierror)
1266 if( ierror /= 0 )
then
1267 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_DOF>'
1269 call hecmw_abort( hecmw_comm_get_comm())
1272 if(
associated(fstrsolid%CLOAD_ngrp_val) )
then
1273 deallocate(fstrsolid%CLOAD_ngrp_val, stat=ierror)
1274 if( ierror /= 0 )
then
1275 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_val>'
1277 call hecmw_abort( hecmw_comm_get_comm())
1280 if(
associated(fstrsolid%CLOAD_ngrp_amp) )
then
1281 deallocate(fstrsolid%CLOAD_ngrp_amp, stat=ierror)
1282 if( ierror /= 0 )
then
1283 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_amp>'
1285 call hecmw_abort( hecmw_comm_get_comm())
1288 if(
associated(fstrsolid%CLOAD_ngrp_rotID) )
then
1289 deallocate(fstrsolid%CLOAD_ngrp_rotID, stat=ierror)
1290 if( ierror /= 0 )
then
1291 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_rotID>'
1293 call hecmw_abort( hecmw_comm_get_comm())
1296 if(
associated(fstrsolid%CLOAD_ngrp_centerID) )
then
1297 deallocate(fstrsolid%CLOAD_ngrp_centerID, stat=ierror)
1298 if( ierror /= 0 )
then
1299 write(
idbg,*)
'stop due to deallocation error <FSTR_SOLID, CLOAD_ngrp_centerID>'
1301 call hecmw_abort( hecmw_comm_get_comm())
1312 fstrheat%STEPtot = 0
1313 fstrheat%MATERIALtot = 0
1314 fstrheat%AMPLITUDEtot= 0
1315 fstrheat%T_FIX_tot = 0
1316 fstrheat%Q_NOD_tot = 0
1317 fstrheat%Q_VOL_tot = 0
1318 fstrheat%Q_SUF_tot = 0
1319 fstrheat%R_SUF_tot = 0
1320 fstrheat%H_SUF_tot = 0
1330 fstreig%maxiter = 60
1332 fstreig%sigma = 0.0d0
1333 fstreig%tolerance = 1.0d-6
1334 fstreig%totalmass = 0.0d0
1341 fstrdynamic%idx_eqa = 1
1342 fstrdynamic%idx_resp = 1
1343 fstrdynamic%n_step = 1
1344 fstrdynamic%t_start = 0.0
1345 fstrdynamic%t_curr = 0.0d0
1346 fstrdynamic%t_end = 1.0
1347 fstrdynamic%t_delta = 1.0
1348 fstrdynamic%ganma = 0.5
1349 fstrdynamic%beta = 0.25
1350 fstrdynamic%idx_mas = 1
1351 fstrdynamic%idx_dmp = 1
1352 fstrdynamic%ray_m = 0.0
1353 fstrdynamic%ray_k = 0.0
1354 fstrdynamic%restart_nout = 0
1355 fstrdynamic%nout = 100
1356 fstrdynamic%ngrp_monit = 0
1357 fstrdynamic%nout_monit = 1
1358 fstrdynamic%iout_list(1) = 0
1359 fstrdynamic%iout_list(2) = 0
1360 fstrdynamic%iout_list(3) = 0
1361 fstrdynamic%iout_list(4) = 0
1362 fstrdynamic%iout_list(5) = 0
1363 fstrdynamic%iout_list(6) = 0
1371 type(hecmwst_local_mesh),
target :: hecMESH
1374 integer :: ierror, ndof,nnod
1378 if(fstrdynamic%idx_eqa == 11)
then
1379 allocate( fstrdynamic%DISP(ndof*nnod,3) ,stat=ierror )
1380 if( ierror /= 0 )
then
1381 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, DISP>'
1382 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1384 call hecmw_abort( hecmw_comm_get_comm())
1386 allocate( fstrdynamic%VEL (ndof*nnod,1) ,stat=ierror )
1387 if( ierror /= 0 )
then
1388 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, VEL>'
1389 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1391 call hecmw_abort( hecmw_comm_get_comm())
1393 allocate( fstrdynamic%ACC (ndof*nnod,1) ,stat=ierror )
1394 if( ierror /= 0 )
then
1395 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, ACC>'
1396 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1398 call hecmw_abort( hecmw_comm_get_comm())
1401 allocate( fstrdynamic%DISP(ndof*nnod,2) ,stat=ierror )
1402 if( ierror /= 0 )
then
1403 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, DISP>'
1404 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1406 call hecmw_abort( hecmw_comm_get_comm())
1408 allocate( fstrdynamic%VEL (ndof*nnod,2) ,stat=ierror )
1409 if( ierror /= 0 )
then
1410 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, VEL>'
1411 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1413 call hecmw_abort( hecmw_comm_get_comm())
1415 allocate( fstrdynamic%ACC (ndof*nnod,2) ,stat=ierror )
1416 if( ierror /= 0 )
then
1417 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, ACC>'
1418 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1420 call hecmw_abort( hecmw_comm_get_comm())
1425 allocate( fstrdynamic%VEC1(ndof*nnod) ,stat=ierror )
1426 if( ierror /= 0 )
then
1427 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, VEC1>'
1428 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1430 call hecmw_abort( hecmw_comm_get_comm())
1432 allocate( fstrdynamic%VEC2(ndof*nnod) ,stat=ierror )
1433 if( ierror /= 0 )
then
1434 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, VEC2>'
1435 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1437 call hecmw_abort( hecmw_comm_get_comm())
1439 allocate( fstrdynamic%VEC3(ndof*nnod) ,stat=ierror )
1440 if( ierror /= 0 )
then
1441 write(
idbg,*)
'stop due to allocation error <fstr_solve_LINEAR_DYNAMIC, VEC3>'
1442 write(
idbg,*)
' rank = ', hecmesh%my_rank,
' ierror = ',ierror
1444 call hecmw_abort( hecmw_comm_get_comm())
1454 if(
associated(fstrdynamic%DISP) ) &
1455 deallocate( fstrdynamic%DISP ,stat=ierror )
1456 if( ierror /= 0 )
then
1457 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, DISP>'
1459 call hecmw_abort( hecmw_comm_get_comm())
1461 if(
associated(fstrdynamic%VEL) ) &
1462 deallocate( fstrdynamic%VEL ,stat=ierror )
1463 if( ierror /= 0 )
then
1464 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, VEL>'
1466 call hecmw_abort( hecmw_comm_get_comm())
1468 if(
associated(fstrdynamic%ACC) ) &
1469 deallocate( fstrdynamic%ACC ,stat=ierror )
1470 if( ierror /= 0 )
then
1471 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, ACC>'
1473 call hecmw_abort( hecmw_comm_get_comm())
1475 if(
associated(fstrdynamic%VEC1) ) &
1476 deallocate( fstrdynamic%VEC1 ,stat=ierror )
1477 if( ierror /= 0 )
then
1478 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, VEC1>'
1480 call hecmw_abort( hecmw_comm_get_comm())
1482 if(
associated(fstrdynamic%VEC2) ) &
1483 deallocate( fstrdynamic%VEC2 ,stat=ierror )
1484 if( ierror /= 0 )
then
1485 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, VEC2>'
1487 call hecmw_abort( hecmw_comm_get_comm())
1489 if(
associated(fstrdynamic%VEC3) ) &
1490 deallocate( fstrdynamic%VEC3 ,stat=ierror )
1491 if( ierror /= 0 )
then
1492 write(
idbg,*)
'stop due to deallocation error <fstr_solve_LINEAR_DYNAMIC, VEC3>'
1494 call hecmw_abort( hecmw_comm_get_comm())
1506 integer(kind=kint) :: NDOF, n_node, n_elem, mdof
1507 mdof = (ndof*ndof+ndof)/2;
1508 allocate ( phys%STRAIN (mdof*n_node))
1509 allocate ( phys%STRESS (mdof*n_node))
1510 allocate ( phys%MISES ( n_node))
1511 allocate ( phys%ESTRAIN (mdof*n_elem))
1512 allocate ( phys%ESTRESS (mdof*n_elem))
1513 allocate ( phys%EMISES ( n_elem))
1514 allocate ( phys%ENQM (12*n_elem))
1519 integer(kind=kint) :: ctrl, i
1523 if( p%PARAM%solution_type ==
kststatic &
1524 .or. p%PARAM%solution_type ==
ksteigen &
1528 if( p%MESH%n_dof == 6 .or. p%SOLID%is_33shell == 1 )
then
1529 allocate ( p%SOLID%SHELL )
1531 allocate ( p%SOLID%SHELL%LAYER(p%SOLID%max_lyr) )
1532 do i=1,p%SOLID%max_lyr
1533 allocate ( p%SOLID%SHELL%LAYER(i)%PLUS )
1534 allocate ( p%SOLID%SHELL%LAYER(i)%MINUS )
1538 phys => p%SOLID%SHELL
1540 allocate ( p%SOLID%SOLID )
1541 phys => p%SOLID%SOLID
1544 p%SOLID%STRAIN => phys%STRAIN
1545 p%SOLID%STRESS => phys%STRESS
1546 p%SOLID%MISES => phys%MISES
1547 p%SOLID%ESTRAIN => phys%ESTRAIN
1548 p%SOLID%ESTRESS => phys%ESTRESS
1549 p%SOLID%EMISES => phys%EMISES
1550 p%SOLID%ENQM => phys%ENQM
1551 allocate( p%SOLID%REACTION( p%MESH%n_dof*p%MESH%n_node ) )
1554 if( p%PARAM%fg_visual ==
kon )
then
1558 call hecmw_barrier( p%MESH )
1560 if( p%HEAT%STEPtot == 0 )
then
1561 if( p%PARAM%analysis_n == 0 )
then
1568 p%PARAM%analysis_n = 1
1574 p%PARAM%eps = 1.0e-6
1581 p%HEAT%STEP_DLTIME = 0
1582 p%HEAT%STEP_EETIME = 0
1583 p%HEAT%STEP_DELMIN = 0
1584 p%HEAT%STEP_DELMAX = 0
1598 integer(kind=kint) :: ctrl
1599 integer(kind=kint) :: counter
1602 integer(kind=kint) :: rcode
1615 integer(kind=kint) :: ctrl
1616 integer(kind=kint) :: counter
1619 integer(kind=kint) :: rcode
1621 if( counter >= 2 )
then
1622 write(
ilog,*)
'### Error : !SOLVER exists twice in FSTR control file.'
1680 integer(kind=kint) :: ctrl
1681 type( hecmwst_local_mesh ) :: hecmesh
1683 type( tlocalcoordsys ) :: coordsys
1685 integer :: j, is, ie, grp_id(1)
1686 character(len=HECMW_NAME_LEN) :: grp_id_name(1)
1688 integer :: nid, dtype
1689 character(len=HECMW_NAME_LEN) :: data_fmt
1690 real(kind=kreal) :: fdum, xyza(3), xyzb(3), xyzc(3), ff1(3), ff2(3), ff3(3)
1695 coordsys%sys_type = 10
1698 data_fmt =
'COORDINATES,NODES '
1701 coordsys%sys_type = coordsys%sys_type + dtype
1704 coordsys%sys_name = grp_id_name(1)
1708 data_fmt =
"RRRRRRrrr "
1711 xyza(3), xyzb(1), xyzb(2), xyzb(3), xyzc(1), xyzc(2), xyzc(3) )/=0 )
return
1712 if( coordsys%sys_type==10 )
then
1714 fdum = dsqrt( dot_product(ff1, ff1) )
1715 if( fdum==0.d0 )
return
1719 coordsys%CoordSys(1,:) = ff1
1721 fdum = dsqrt( dot_product(ff3, ff3) )
1722 if( fdum==0.d0 )
return
1723 coordsys%CoordSys(3,:) = ff3/fdum
1725 call cross_product(coordsys%CoordSys(3,:), coordsys%CoordSys(1,:), coordsys%CoordSys(2,:) )
1727 coordsys%CoordSys(1,:) = xyza
1728 coordsys%CoordSys(2,:) = xyzb
1732 coordsys%node_ID(3) = 0
1735 coordsys%node_ID(2), coordsys%node_ID(3) )/=0 )
return
1736 if( coordsys%node_ID(3) == 0 )
then
1738 if( nid/=0 .and. nid/=2 )
then
1739 write(*,*)
"We cannot define coordinate system using nodes in other CPU!"
1740 write(
idbg,*)
"We cannot define coordinate system using nodes in other CPU!"
1745 if( nid/=0 .and. nid/=3 )
then
1746 write(*,*)
"We cannot define coordinate system using nodes in other CPU!"
1747 write(
idbg,*)
"We cannot define coordinate system using nodes in other CPU!"
1763 integer(kind=kint) :: ctrl
1764 integer(kind=kint) :: counter
1766 character(HECMW_NAME_LEN) :: amp
1767 integer(kind=kint) :: amp_id
1769 integer(kind=kint) :: rcode, iproc
1781 integer(kind=kint) :: ctrl
1783 type(hecmwst_local_mesh) :: hecmesh
1784 integer,
pointer :: grp_id(:), dof(:)
1785 real(kind=kreal),
pointer :: temp(:)
1786 character(len=HECMW_NAME_LEN),
pointer :: grp_id_name(:)
1787 character(len=HECMW_NAME_LEN) :: data_fmt, ss
1788 integer :: i,j,n, is, ie, gid, nid, rcode
1792 ss =
'TEMPERATURE,VELOCITY,ACCELERATION '
1795 cond%cond_name =
"temperature"
1796 allocate( cond%intval(hecmesh%n_node) )
1797 allocate( cond%realval(hecmesh%n_node) )
1798 elseif( nid==2 )
then
1799 cond%cond_name =
"velocity"
1800 allocate( cond%intval(hecmesh%n_node) )
1801 allocate( cond%realval(hecmesh%n_node) )
1802 elseif( nid==3 )
then
1803 cond%cond_name =
"acceleration"
1804 allocate( cond%intval(hecmesh%n_node) )
1805 allocate( cond%realval(hecmesh%n_node) )
1815 allocate( temp(n), grp_id_name(n), grp_id(n), dof(n) )
1817 write(ss,*) hecmw_name_len
1819 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'R '
1823 write(data_fmt,
'(a,a,a)')
'S',trim(adjustl(ss)),
'IR '
1829 if(
associated(grp_id) )
deallocate( grp_id )
1830 if(
associated(temp) )
deallocate( temp )
1831 if(
associated(dof) )
deallocate( dof )
1832 if(
associated(grp_id_name) )
deallocate( grp_id_name )
1839 is = hecmesh%node_group%grp_index(gid-1) + 1
1840 ie = hecmesh%node_group%grp_index(gid )
1842 nid = hecmesh%node_group%grp_item(j)
1843 cond%realval(nid) = temp(i)
1844 cond%intval(nid) = dof(i)
1848 if(
associated(grp_id) )
deallocate( grp_id )
1849 if(
associated(temp) )
deallocate( temp )
1850 if(
associated(dof) )
deallocate( dof )
1851 if(
associated(grp_id_name) )
deallocate( grp_id_name )
1860 integer(kind=kint) :: ctrl
1861 integer(kind=kint) :: counter
1863 integer(kind=kint) :: res, visual, neutral
1865 integer(kind=kint) :: rcode
1869 if( res == 1 ) p%PARAM%fg_result = 1
1870 if( visual == 1 ) p%PARAM%fg_visual = 1
1871 if( neutral == 1 ) p%PARAM%fg_neutral = 1
1881 integer(kind=kint) :: ctrl
1882 integer(kind=kint) :: counter
1885 integer(kind=kint) :: rcode
1899 integer(kind=kint) :: ctrl
1900 integer(kind=kint) :: nout
1901 integer(kind=kint) :: version
1903 integer(kind=kint) :: rcode
1919 integer(kind=kint) :: ctrl
1920 integer(kind=kint) :: counter
1922 integer(kind=kint) :: rcode
1923 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
1924 integer(kind=kint) :: i, n, old_size, new_size
1926 if( p%SOLID%file_type /=
kbcffstr )
return
1930 old_size = p%SOLID%COUPLE_ngrp_tot
1931 new_size = old_size + n
1932 p%SOLID%COUPLE_ngrp_tot = new_size
1936 allocate( grp_id_name(n))
1938 p%PARAM%fg_couple_type, &
1939 p%PARAM%fg_couple_first, &
1940 p%PARAM%fg_couple_window, &
1941 grp_id_name, hecmw_name_len )
1945 n, grp_id_name, p%SOLID%COUPLE_ngrp_ID(old_size+1:))
1947 deallocate( grp_id_name )
1948 p%PARAM%fg_couple = 1
1963 integer(kind=kint) :: ctrl
1964 integer(kind=kint) :: counter
1966 integer(kind=kint) :: rcode
1968 integer :: nout, nout_monit,node_monit_1 ,elem_monit_1 ,intg_monit_1
1969 integer :: ipt, idx_elpl, iout_list(6)
1970 real(kind=kreal) :: sig_y0, h_dash
1972 if( counter > 1 )
then
1979 if( ipt == 2 ) p%PARAM%nlgeom = .true.
1983 write(*,*)
"Warning : !STATIC : parameter 'TYPE=INFINITE' is deprecated." &
1984 & //
" Please use the replacement parameter 'TYPE=INFINITESIMAL'"
1992 nout, nout_monit, node_monit_1, &
1993 elem_monit_1, intg_monit_1 )
2006 integer(kind=kint) :: ctrl
2007 integer(kind=kint) :: counter
2010 integer(kind=kint) :: rcode
2011 integer(kind=kint) ::
type = 0
2012 character(HECMW_NAME_LEN) :: amp, rotc_name(1)
2013 integer(kind=kint) :: amp_id, rotc_id(1), n_rotc
2014 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2015 integer(kind=kint),
pointer :: dof_ids (:)
2016 integer(kind=kint),
pointer :: dof_ide (:)
2017 real(kind=kreal),
pointer :: val_ptr(:)
2018 integer(kind=kint) :: i, n, old_size, new_size
2020 integer(kind=kint) :: gid
2036 if( rotc_name(1) /=
' ' )
then
2037 p%SOLID%BOUNDARY_ngrp_rot = p%SOLID%BOUNDARY_ngrp_rot + 1
2038 n_rotc = p%SOLID%BOUNDARY_ngrp_rot
2048 old_size = p%SOLID%BOUNDARY_ngrp_tot
2049 new_size = old_size + n
2050 p%SOLID%BOUNDARY_ngrp_tot = new_size
2059 allocate( grp_id_name(n) )
2060 allocate( dof_ids(n) )
2061 allocate( dof_ide(n) )
2064 val_ptr => p%SOLID%BOUNDARY_ngrp_val(old_size+1:)
2069 p%SOLID%BOUNDARY_ngrp_GRPID(old_size+1:new_size) = gid
2073 p%SOLID%BOUNDARY_ngrp_rotID(old_size+1:) = n_rotc
2074 p%SOLID%BOUNDARY_ngrp_centerID(old_size+1:) = rotc_id(1)
2077 if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) )
then
2078 write(*,*)
'fstr contol file error : !BOUNDARY : range of dof_ids and dof_ide is from 1 to 6'
2079 write(
ilog,*)
'fstr contol file error : !BOUNDARY : range of dof_ids and dof_ide is from 1 to 6'
2082 p%SOLID%BOUNDARY_ngrp_type(old_size+i) = 10 * dof_ids(i) + dof_ide(i)
2083 p%SOLID%BOUNDARY_ngrp_amp(old_size+i) = amp_id
2086 deallocate( grp_id_name )
2087 deallocate( dof_ids )
2088 deallocate( dof_ide )
2105 integer(kind=kint) :: ctrl
2106 integer(kind=kint) :: counter
2109 integer(kind=kint) :: rcode
2110 character(HECMW_NAME_LEN) :: amp, rotc_name(1)
2111 integer(kind=kint) :: amp_id, rotc_id(1), n_rotc
2112 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2113 real(kind=kreal),
pointer :: val_ptr(:)
2114 integer(kind=kint),
pointer :: id_ptr(:)
2115 integer(kind=kint) :: i, n, old_size, new_size
2116 integer(kind=kint) :: gid
2118 if( p%SOLID%file_type /=
kbcffstr )
return
2129 if( rotc_name(1) /=
' ' )
then
2130 p%SOLID%CLOAD_ngrp_rot = p%SOLID%CLOAD_ngrp_rot + 1
2131 n_rotc = p%SOLID%CLOAD_ngrp_rot
2137 old_size = p%SOLID%CLOAD_ngrp_tot
2138 new_size = old_size + n
2139 p%SOLID%CLOAD_ngrp_tot = new_size
2150 allocate( grp_id_name(n))
2152 val_ptr => p%SOLID%CLOAD_ngrp_val(old_size+1:)
2153 id_ptr =>p%SOLID%CLOAD_ngrp_DOF(old_size+1:)
2159 p%SOLID%CLOAD_ngrp_rotID(old_size+1:) = n_rotc
2160 p%SOLID%CLOAD_ngrp_centerID(old_size+1:) = rotc_id(1)
2164 p%SOLID%CLOAD_ngrp_amp(old_size+i) = amp_id
2166 p%SOLID%CLOAD_ngrp_GRPID(old_size+1:new_size) = gid
2169 deallocate( grp_id_name )
2176 include
'fstr_ctrl_freq.f90'
2184 real(kind=kreal),
pointer :: array(:,:)
2185 integer(kind=kint) :: old_size, new_size, i, j
2186 real(kind=kreal),
pointer :: temp(:,:)
2188 if( old_size >= new_size )
then
2192 if(
associated( array ) )
then
2193 allocate(temp(0:6, old_size))
2196 allocate(array(0:6, new_size))
2200 array(j,i) = temp(j,i)
2205 allocate(array(0:6, new_size))
2213 integer(kind=kint) :: ctrl
2214 integer(kind=kint) :: counter
2217 integer(kind=kint) :: rcode
2218 character(HECMW_NAME_LEN) :: amp
2219 integer(kind=kint) :: amp_id
2220 integer(kind=kint) :: follow
2221 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2222 real(kind=kreal),
pointer :: new_params(:,:)
2223 logical,
pointer :: fg_surface(:)
2224 integer(kind=kint),
pointer :: lid_ptr(:)
2225 integer(kind=kint) :: i, j, n, old_size, new_size
2226 integer(kind=kint) :: gid
2228 if( p%SOLID%file_type /=
kbcffstr )
return
2235 old_size = p%SOLID%DLOAD_ngrp_tot
2236 new_size = old_size + n
2237 p%SOLID%DLOAD_ngrp_tot = new_size
2246 allocate( grp_id_name(n))
2247 allocate( new_params(0:6,n))
2248 allocate( fg_surface(n))
2251 follow = p%SOLID%DLOAD_follow
2252 if( .not. p%PARAM%nlgeom ) follow = 0
2253 lid_ptr => p%SOLID%DLOAD_ngrp_LID(old_size+1:)
2255 grp_id_name, hecmw_name_len, &
2256 lid_ptr, new_params )
2259 p%SOLID%DLOAD_follow = follow
2261 p%SOLID%DLOAD_ngrp_amp(old_size+i) = amp_id
2263 p%SOLID%DLOAD_ngrp_params(j,old_size+i) = new_params(j,i)
2265 fg_surface(i) = ( lid_ptr(i) == 100 )
2267 p%SOLID%DLOAD_ngrp_GRPID(old_size+1:new_size) = gid
2269 deallocate( grp_id_name )
2270 deallocate( new_params )
2271 deallocate( fg_surface )
2281 integer(kind=kint) :: ctrl
2282 integer(kind=kint) :: counter
2285 integer(kind=kint) :: rcode, gid
2286 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2287 real(kind=kreal),
pointer :: val_ptr(:)
2288 integer(kind=kint) :: n, old_size, new_size
2290 if( p%SOLID%file_type /=
kbcffstr )
return
2296 old_size = p%SOLID%TEMP_ngrp_tot
2298 new_size = old_size + n
2300 new_size = old_size + 1
2306 allocate( grp_id_name(n))
2307 val_ptr => p%SOLID%TEMP_ngrp_val( old_size+1: )
2310 p%SOLID%TEMP_irres, &
2311 p%SOLID%TEMP_tstep, &
2312 p%SOLID%TEMP_interval, &
2313 p%SOLID%TEMP_rtype, &
2314 grp_id_name, hecmw_name_len, &
2318 p%SOLID%TEMP_ngrp_GRPID(old_size+1:new_size) = gid
2320 if( p%SOLID%TEMP_irres == 0 )
then
2321 p%SOLID%TEMP_ngrp_tot = new_size
2323 n, grp_id_name, p%SOLID%TEMP_ngrp_ID(old_size+1:))
2325 deallocate( grp_id_name )
2337 integer(kind=kint) :: ctrl
2338 integer(kind=kint) :: counter
2341 integer(kind=kint) :: rcode
2342 character(HECMW_NAME_LEN) :: amp
2343 integer(kind=kint) :: amp_id
2344 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2345 real(kind=kreal),
pointer :: val_ptr(:)
2346 integer(kind=kint),
pointer :: id_ptr(:)
2347 integer(kind=kint) :: i, n, old_size, new_size
2348 integer(kind=kint) :: gid
2350 if( p%SOLID%file_type /=
kbcffstr )
return
2355 old_size = p%SOLID%SPRING_ngrp_tot
2356 new_size = old_size + n
2357 p%SOLID%SPRING_ngrp_tot = new_size
2364 allocate( grp_id_name(n))
2366 val_ptr => p%SOLID%SPRING_ngrp_val(old_size+1:)
2367 id_ptr =>p%SOLID%SPRING_ngrp_DOF(old_size+1:)
2374 p%SOLID%SPRING_ngrp_amp(old_size+i) = amp_id
2376 p%SOLID%SPRING_ngrp_GRPID(old_size+1:new_size) = gid
2379 deallocate( grp_id_name )
2390 integer(kind=kint) :: ctrl
2391 integer(kind=kint) :: counter
2394 integer(kind=kint) :: rcode
2412 integer(kind=kint) :: ctrl
2413 integer(kind=kint) :: counter
2416 integer(kind=kint) :: rcode
2417 integer(kind=kint) :: n
2418 character(len=HECMW_NAME_LEN) :: mName
2419 integer(kind=kint) :: i
2431 p%PARAM%analysis_n = n
2438 p%PARAM%eps = 1.0e-6
2439 p%PARAM%timepoint_id = 0
2449 if( rcode /= 0 )
then
2453 if(
associated(p%PARAM%timepoints) )
then
2454 do i=1,
size(p%PARAM%timepoints)
2455 if(
fstr_streqr( p%PARAM%timepoints(i)%name, mname ) )
then
2456 p%PARAM%timepoint_id = i;
exit
2467 p%HEAT%STEP_DLTIME = p%PARAM%dtime
2468 p%HEAT%STEP_EETIME = p%PARAM%etime
2469 p%HEAT%STEP_DELMIN = p%PARAM%dtmin
2470 p%HEAT%STEP_DELMAX = p%PARAM%delmax
2471 p%HEAT%timepoint_id = p%PARAM%timepoint_id
2481 integer(kind=kint) :: ctrl
2482 integer(kind=kint) :: counter
2485 integer(kind=kint) :: rcode
2486 character(HECMW_NAME_LEN) :: amp
2487 integer(kind=kint) :: amp_id
2488 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2489 real(kind=kreal),
pointer :: value(:)
2490 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2491 integer(kind=kint),
pointer :: member(:)
2492 integer(kind=kint) :: local_id, rtc
2498 allocate( grp_id_name(n))
2503 grp_id_name, hecmw_name_len,
value )
2514 else if( rtc < 0 )
then
2520 deallocate( grp_id_name )
2526 old_size = p%HEAT%T_FIX_tot
2527 new_size = old_size + m
2531 p%HEAT%T_FIX_tot = new_size
2534 member => p%HEAT%T_FIX_node(head:)
2540 member(1) = local_id
2542 else if( rtc < 0 )
then
2543 member_n =
get_grp_member( p%MESH,
'node_grp', grp_id_name(i), member )
2548 member => member( member_n+1 : )
2551 p%HEAT%T_FIX_val (id) = value(i)
2552 p%HEAT%T_FIX_ampl (id) = amp_id
2557 deallocate( grp_id_name )
2568 integer(kind=kint) :: ctrl
2569 integer(kind=kint) :: counter
2572 integer(kind=kint) :: rcode
2573 character(HECMW_NAME_LEN) :: amp
2574 integer(kind=kint) :: amp_id
2575 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2576 real(kind=kreal),
pointer :: value(:)
2577 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2578 integer(kind=kint),
pointer :: member(:)
2579 integer(kind=kint) :: local_id, rtc
2585 allocate( grp_id_name(n))
2590 grp_id_name, hecmw_name_len,
value )
2601 else if( rtc < 0 )
then
2607 deallocate( grp_id_name )
2613 old_size = p%HEAT%Q_NOD_tot
2614 new_size = old_size + m
2618 p%HEAT%Q_NOD_tot = new_size
2621 member => p%HEAT%Q_NOD_node(head:)
2626 member(1) = local_id
2628 else if( rtc < 0 )
then
2629 member_n =
get_grp_member( p%MESH,
'node_grp', grp_id_name(i), member )
2633 if( i<n ) member => member( member_n+1 : )
2635 p%HEAT%Q_NOD_val (id) = value(i)
2636 p%HEAT%Q_NOD_ampl (id) = amp_id
2641 deallocate( grp_id_name )
2653 integer(kind=kint) :: ctrl
2654 integer(kind=kint) :: counter
2657 integer(kind=kint) :: rcode
2658 character(HECMW_NAME_LEN) :: amp
2659 integer(kind=kint) :: amp_id
2660 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2661 integer(kind=kint),
pointer :: load_type(:)
2662 real(kind=kreal),
pointer :: value(:)
2663 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2664 integer(kind=kint),
pointer :: member(:)
2665 integer(kind=kint) :: local_id, rtc
2671 allocate( grp_id_name(n))
2672 allocate( load_type(n))
2677 grp_id_name, hecmw_name_len, load_type,
value )
2687 else if( rtc < 0 )
then
2693 deallocate( grp_id_name )
2694 deallocate( load_type )
2700 old_size = p%HEAT%Q_SUF_tot
2701 new_size = old_size + m
2706 p%HEAT%Q_SUF_tot = new_size
2709 member => p%HEAT%Q_SUF_elem(head:)
2714 member(1) = local_id
2716 else if( rtc < 0 )
then
2717 member_n =
get_grp_member( p%MESH,
'elem_grp', grp_id_name(i), member )
2721 if( i<n ) member => member( member_n+1 : )
2723 p%HEAT%Q_SUF_surf (id) = load_type(i)
2724 p%HEAT%Q_SUF_val (id) = value(i)
2725 p%HEAT%Q_SUF_ampl (id) = amp_id
2730 deallocate( grp_id_name )
2731 deallocate( load_type )
2743 integer(kind=kint) :: ctrl
2744 integer(kind=kint) :: counter
2747 integer(kind=kint) :: rcode
2748 character(HECMW_NAME_LEN) :: amp
2749 integer(kind=kint) :: amp_id
2750 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2751 real(kind=kreal),
pointer :: value(:)
2752 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2753 integer(kind=kint),
pointer :: member1(:), member2(:)
2759 allocate( grp_id_name(n))
2764 grp_id_name, hecmw_name_len,
value )
2775 deallocate( grp_id_name )
2781 old_size = p%HEAT%Q_SUF_tot
2782 new_size = old_size + m
2787 p%HEAT%Q_SUF_tot = new_size
2790 member1 => p%HEAT%Q_SUF_elem(head:)
2791 member2 => p%HEAT%Q_SUF_surf(head:)
2794 member_n =
get_grp_member( p%MESH,
'surf_grp', grp_id_name(i), member1, member2 )
2796 member1 => member1( member_n+1 : )
2797 member2 => member2( member_n+1 : )
2800 p%HEAT%Q_SUF_val (id) = value(i)
2801 p%HEAT%Q_SUF_ampl (id) = amp_id
2806 deallocate( grp_id_name )
2818 integer(kind=kint) :: ctrl
2819 integer(kind=kint) :: counter
2822 integer(kind=kint) :: rcode
2823 character(HECMW_NAME_LEN) :: amp1, amp2
2824 integer(kind=kint) :: amp_id1, amp_id2
2825 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2826 integer(kind=kint),
pointer :: load_type(:)
2827 real(kind=kreal),
pointer :: value(:)
2828 real(kind=kreal),
pointer :: shink(:)
2829 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2830 integer(kind=kint),
pointer :: member(:)
2831 integer(kind=kint) :: local_id, rtc
2837 allocate( grp_id_name(n))
2838 allocate( load_type(n))
2846 grp_id_name, hecmw_name_len, load_type,
value, shink )
2857 else if( rtc < 0 )
then
2863 deallocate( grp_id_name )
2864 deallocate( load_type )
2871 old_size = p%HEAT%H_SUF_tot
2872 new_size = old_size + m
2877 p%HEAT%H_SUF_tot = new_size
2880 member => p%HEAT%H_SUF_elem(head:)
2885 member(1) = local_id
2887 else if( rtc < 0 )
then
2888 member_n =
get_grp_member( p%MESH,
'elem_grp', grp_id_name(i), member )
2892 if( i<n ) member => member( member_n+1 : )
2894 p%HEAT%H_SUF_surf (id) = load_type(i)
2895 p%HEAT%H_SUF_val (id,1) = value(i)
2896 p%HEAT%H_SUF_val (id,2) = shink(i)
2897 p%HEAT%H_SUF_ampl (id,1) = amp_id1
2898 p%HEAT%H_SUF_ampl (id,2) = amp_id2
2903 deallocate( grp_id_name )
2904 deallocate( load_type )
2917 integer(kind=kint) :: ctrl
2918 integer(kind=kint) :: counter
2921 integer(kind=kint) :: rcode
2922 character(HECMW_NAME_LEN) :: amp1, amp2
2923 integer(kind=kint) :: amp_id1, amp_id2
2924 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
2925 real(kind=kreal),
pointer :: value(:)
2926 real(kind=kreal),
pointer :: shink(:)
2927 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
2928 integer(kind=kint),
pointer :: member1(:), member2(:)
2934 allocate( grp_id_name(n))
2941 grp_id_name, hecmw_name_len,
value, shink )
2953 deallocate( grp_id_name )
2960 old_size = p%HEAT%H_SUF_tot
2961 new_size = old_size + m
2966 p%HEAT%H_SUF_tot = new_size
2969 member1 => p%HEAT%H_SUF_elem(head:)
2970 member2 => p%HEAT%H_SUF_surf(head:)
2973 member_n =
get_grp_member( p%MESH,
'surf_grp', grp_id_name(i), member1, member2 )
2975 member1 => member1( member_n+1 : )
2976 member2 => member2( member_n+1 : )
2979 p%HEAT%H_SUF_val (id,1) = value(i)
2980 p%HEAT%H_SUF_val (id,2) = shink(i)
2981 p%HEAT%H_SUF_ampl (id,1) = amp_id1
2982 p%HEAT%H_SUF_ampl (id,2) = amp_id2
2987 deallocate( grp_id_name )
3000 integer(kind=kint) :: ctrl
3001 integer(kind=kint) :: counter
3004 integer(kind=kint) :: rcode
3005 character(HECMW_NAME_LEN) :: amp1, amp2
3006 integer(kind=kint) :: amp_id1, amp_id2
3007 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
3008 integer(kind=kint),
pointer :: load_type(:)
3009 real(kind=kreal),
pointer :: value(:)
3010 real(kind=kreal),
pointer :: shink(:)
3011 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
3012 integer(kind=kint),
pointer :: member(:)
3013 integer(kind=kint) :: local_id, rtc
3019 allocate( grp_id_name(n))
3020 allocate( load_type(n))
3027 grp_id_name, hecmw_name_len, load_type,
value, shink )
3038 else if( rtc < 0 )
then
3044 deallocate( grp_id_name )
3045 deallocate( load_type )
3052 old_size = p%HEAT%R_SUF_tot
3053 new_size = old_size + m
3058 p%HEAT%R_SUF_tot = new_size
3061 member => p%HEAT%R_SUF_elem(head:)
3066 member(1) = local_id
3068 else if( rtc < 0 )
then
3069 member_n =
get_grp_member( p%MESH,
'elem_grp', grp_id_name(i), member )
3073 if( i<n ) member => member( member_n+1 : )
3075 p%HEAT%R_SUF_surf (id) = load_type(i)
3076 p%HEAT%R_SUF_val (id,1) = value(i)
3077 p%HEAT%R_SUF_val (id,2) = shink(i)
3078 p%HEAT%R_SUF_ampl (id,1) = amp_id1
3079 p%HEAT%R_SUF_ampl (id,2) = amp_id2
3084 deallocate( grp_id_name )
3085 deallocate( load_type )
3098 integer(kind=kint) :: ctrl
3099 integer(kind=kint) :: counter
3102 integer(kind=kint) :: rcode
3103 character(HECMW_NAME_LEN) :: amp1, amp2
3104 integer(kind=kint) :: amp_id1, amp_id2
3105 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
3106 real(kind=kreal),
pointer :: value(:)
3107 real(kind=kreal),
pointer :: shink(:)
3108 integer(kind=kint) :: i, j, n, m, head, id, member_n, old_size, new_size
3109 integer(kind=kint),
pointer :: member1(:), member2(:)
3115 allocate( grp_id_name(n))
3133 deallocate( grp_id_name )
3140 old_size = p%HEAT%R_SUF_tot
3141 new_size = old_size + m
3146 p%HEAT%R_SUF_tot = new_size
3149 member1 => p%HEAT%R_SUF_elem(head:)
3150 member2 => p%HEAT%R_SUF_surf(head:)
3153 member_n =
get_grp_member( p%MESH,
'surf_grp', grp_id_name(i), member1, member2 )
3155 member1 => member1( member_n+1 : )
3156 member2 => member2( member_n+1 : )
3159 p%HEAT%R_SUF_val (id,1) = value(i)
3160 p%HEAT%R_SUF_val (id,2) = shink(i)
3161 p%HEAT%R_SUF_ampl (id,1) = amp_id1
3162 p%HEAT%R_SUF_ampl (id,2) = amp_id2
3167 deallocate( grp_id_name )
3183 integer(kind=kint) :: ctrl
3184 integer(kind=kint) :: counter
3187 integer(kind=kint) :: rcode
3205 integer(kind=kint) :: ctrl
3206 integer(kind=kint) :: counter
3208 integer(kind=kint) :: rcode
3209 character(HECMW_NAME_LEN) :: grp_id_name(1)
3210 integer(kind=kint) :: grp_id(1)
3227 grp_id_name(1), hecmw_name_len, &
3233 if (p%DYN%idx_resp == 1)
then
3235 p%DYN%ngrp_monit = grp_id(1)
3237 read(grp_id_name,*) p%DYN%ngrp_monit
3249 integer(kind=kint) :: ctrl
3250 integer(kind=kint) :: counter
3253 integer(kind=kint) :: rcode
3254 integer(kind=kint) :: vType
3255 character(HECMW_NAME_LEN) :: amp
3256 integer(kind=kint) :: amp_id
3257 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
3258 integer(kind=kint),
pointer :: dof_ids (:)
3259 integer(kind=kint),
pointer :: dof_ide (:)
3260 real(kind=kreal),
pointer :: val_ptr(:)
3261 integer(kind=kint) :: i, j, n, old_size, new_size
3265 old_size = p%SOLID%VELOCITY_ngrp_tot
3266 new_size = old_size + n
3267 p%SOLID%VELOCITY_ngrp_tot = new_size
3274 allocate( grp_id_name(n))
3275 allocate( dof_ids(n))
3276 allocate( dof_ide(n))
3279 val_ptr => p%SOLID%VELOCITY_ngrp_val(old_size+1:)
3282 grp_id_name, hecmw_name_len, &
3283 dof_ids, dof_ide, val_ptr )
3285 p%SOLID%VELOCITY_type = vtype
3286 if( vtype ==
kbcinitial ) p%DYN%VarInitialize = .true.
3289 n, grp_id_name, p%SOLID%VELOCITY_ngrp_ID(old_size+1:))
3293 if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) )
then
3294 write(
ilog,*)
'fstr contol file error : !VELOCITY : range of dof_ids and dof_ide is from 1 to 6'
3297 p%SOLID%VELOCITY_ngrp_type(j) = 10 * dof_ids(i) + dof_ide(i)
3298 p%SOLID%VELOCITY_ngrp_amp(j) = amp_id
3302 deallocate( grp_id_name )
3303 deallocate( dof_ids )
3304 deallocate( dof_ide )
3315 integer(kind=kint) :: ctrl
3316 integer(kind=kint) :: counter
3319 integer(kind=kint) :: rcode
3320 integer(kind=kint) :: aType
3321 character(HECMW_NAME_LEN) :: amp
3322 integer(kind=kint) :: amp_id
3323 character(HECMW_NAME_LEN),
pointer :: grp_id_name(:)
3324 integer(kind=kint),
pointer :: dof_ids (:)
3325 integer(kind=kint),
pointer :: dof_ide (:)
3326 real(kind=kreal),
pointer :: val_ptr(:)
3327 integer(kind=kint) :: i, j, n, old_size, new_size
3332 old_size = p%SOLID%ACCELERATION_ngrp_tot
3333 new_size = old_size + n
3334 p%SOLID%ACCELERATION_ngrp_tot = new_size
3341 allocate( grp_id_name(n))
3342 allocate( dof_ids(n))
3343 allocate( dof_ide(n))
3346 val_ptr => p%SOLID%ACCELERATION_ngrp_val(old_size+1:)
3349 grp_id_name, hecmw_name_len, &
3350 dof_ids, dof_ide, val_ptr)
3352 p%SOLID%ACCELERATION_type = atype
3353 if( atype ==
kbcinitial )p%DYN%VarInitialize = .true.
3356 n, grp_id_name, p%SOLID%ACCELERATION_ngrp_ID(old_size+1:))
3360 if( (dof_ids(i) < 1).or.(6 < dof_ids(i)).or.(dof_ide(i) < 1).or.(6 < dof_ide(i)) )
then
3361 write(
ilog,*)
'fstr contol file error : !ACCELERATION : range of dof_ids and dof_ide is from 1 to 6'
3364 p%SOLID%ACCELERATION_ngrp_type(j) = 10 * dof_ids(i) + dof_ide(i)
3365 p%SOLID%ACCELERATION_ngrp_amp(j) = amp_id
3369 deallocate( grp_id_name )
3370 deallocate( dof_ids )
3371 deallocate( dof_ide )
3385 integer(kind=kint) :: ctrl
3386 integer(kind=kint) :: counter
3389 integer(kind=kint) :: rcode
3435 integer(kind=kint) :: ctrl
3436 type (hecmwST_local_mesh) :: hecMESH
3437 type (fstr_solid ) :: fstrSOLID
3438 write(
ilog,*)
'### Error : In !BOUNNDARY, TYPE=NASTRAN is not supported.'
3439 call hecmw_abort( hecmw_comm_get_comm())
3448 integer(kind=kint) :: ctrl
3452 integer(kind=kint) :: rcode
3466 integer(kind=kint) :: ctrl
3469 integer(kind=kint) :: rcode, nid
3470 character(len=HECMW_NAME_LEN) :: data_fmt
3472 data_fmt =
'SOLUTION,MATERIAL '
3485 type(hecmwst_local_mesh),
pointer :: hecMESH
3486 integer(kind=kint) :: n, i, sgrp_id, ngrp_id, ngrp_id2
3488 n = hecmesh%contact_pair%n_pair
3490 if( hecmesh%contact_pair%type(i) /= hecmw_contact_type_surf_surf ) cycle
3491 sgrp_id = hecmesh%contact_pair%slave_grp_id(i)
3494 hecmesh%contact_pair%type(i) = hecmw_contact_type_node_surf
3495 hecmesh%contact_pair%slave_grp_id(i) = ngrp_id
subroutine fstr_setup_eigenread(ctrl, counter, P)
Read in !EIGENREAD !
subroutine fstr_setup_fload(ctrl, counter, P)
This source file contains subroutine for reading control data for harmonic response analysis (this im...
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_close(int *ctrl)
int fstr_ctrl_get_data_line_n(int *ctrl)
int fstr_ctrl_seek_next_header(int *ctrl)
int fstr_ctrl_get_data_array_ex(int *ctrl, const char *format,...)
int fstr_ctrl_open(char *filename)
int fstr_ctrl_get_c_h_name(int *ctrl, char *header_name, int *buff_size)
int fstr_ctrl_rewind(int *ctrl)
This module encapsulate the basic functions of all elements provide by this software.
integer function numofquadpoints(fetype)
Obtains the number of quadrature points of the element.
integer(kind=kind(2)) function getspacedimension(etype)
Obtain the space dimension of the element.
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 control file data obtaining functions for dynamic analysis.
integer(kind=kint) function fstr_ctrl_get_velocity(ctrl, vType, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !VELOCITY.
integer(kind=kint) function fstr_ctrl_get_acceleration(ctrl, aType, amp, node_id, node_id_len, dof_ids, dof_ide, value)
Read in !ACCELERATION.
integer(kind=kint) function fstr_ctrl_get_dynamic(ctrl, nlgeom, idx_eqa, idx_resp, n_step, t_start, t_end, t_delta, ganma, beta, idx_mas, idx_dmp, ray_m, ray_k, nout, node_id, node_id_len, nout_monit, iout_list)
Read in !DYNAMIC.
This module contains control file data obtaining functions for dynamic analysis.
integer(kind=kint) function fstr_ctrl_get_eigen(ctrl, nget, tolerance, maxiter)
Read in !EIGEN (struct)
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 manages read in of various material properties.
integer function fstr_ctrl_get_hyperelastic(ctrl, mattype, nlgeom, matval)
Read in !HYPERELASTIC.
integer function fstr_ctrl_get_viscoelasticity(ctrl, mattype, nlgeom, dict)
Read in !VISCOELASTIC.
integer function fstr_ctrl_get_viscoplasticity(ctrl, mattype, nlgeom, dict)
Read in !VISCOELASTIC.
integer function fstr_ctrl_get_usermaterial(ctrl, mattype, nlgeom, nstatus, matval)
Read in !USER_MATERIAL.
integer function fstr_ctrl_get_expansion_coeff(ctrl, matval, dict)
Read in !EXPANSION_COEFF.
integer function fstr_ctrl_get_trs(ctrl, mattype, matval)
Read in !TRS.
integer function fstr_ctrl_get_elasticity(ctrl, mattype, nlgeom, matval, dict)
Read in !ELASTIC.
integer function fstr_ctrl_get_plasticity(ctrl, mattype, nlgeom, matval, mattable, dict)
Read in !PLASTIC.
integer function fstr_ctrl_get_material(ctrl, matname)
Read in !MATERIAL.
integer function fstr_ctrl_get_density(ctrl, matval)
Read in !DENSITY.
integer function fstr_ctrl_get_fluid(ctrl, mattype, nlgeom, matval, dict)
Read in !FLUID.
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.
This module contains auxiliary functions in calculation setup.
integer(kind=kint) function get_grp_member_n(hecMESH, grp_type_name, name)
subroutine fstr_ctrl_err_stop
subroutine node_grp_name_to_id_ex(hecMESH, header_name, n, grp_id_name, grp_ID)
subroutine surf_grp_name_to_id_ex(hecMESH, header_name, n, grp_id_name, grp_ID)
subroutine dload_grp_name_to_id_ex(hecMESH, n, grp_id_name, fg_surface, grp_ID)
subroutine fstr_setup_visualize(ctrl, my_rank)
integer(kind=kint) function get_local_member_index(hecMESH, type_name, name, local_id)
subroutine fstr_expand_real_array2(array, column, old_size, new_size)
integer(kind=kint) function get_grp_member(hecMESH, grp_type_name, name, member1, member2)
subroutine fstr_expand_integer_array(array, old_size, new_size)
subroutine fstr_expand_real_array(array, old_size, new_size)
subroutine amp_name_to_id(hecMESH, header_name, aname, id)
subroutine append_node_grp_from_surf_grp(hecMESH, sgrp_id, ngrp_id)
integer(kind=kint) function node_global_to_local(hecMESH, list, n)
subroutine fstr_strupr(s)
subroutine reallocate_real(array, n)
subroutine reallocate_integer(array, n)
integer(kind=kint) function get_sorted_local_member_index(hecMESH, hecPARAM, type_name, name, local_id)
subroutine fstr_expand_integer_array2(array, column, old_size, new_size)
logical function fstr_streqr(s1, s2)
This module provides functions to read in data from control file and do neccessary preparation for fo...
subroutine fstr_setup_boundary(ctrl, counter, P)
Read in !BOUNDARY !
subroutine fstr_setup_static(ctrl, counter, P)
Read in !STATIC(old) !
subroutine fstr_setup_mpc(ctrl, counter, P)
Read in !MPC !
integer(kind=kint) function fstr_setup_initial(ctrl, cond, hecMESH)
subroutine fstr_setup_sradiate(ctrl, counter, P)
Read in !SRADIATE !
subroutine fstr_setup_radiate(ctrl, counter, P)
Read in !RADIATE !
subroutine fstr_setup_contactalgo(ctrl, P)
Read in !CONTACT !
subroutine fstr_setup_dload(ctrl, counter, P)
Read in !DLOAD.
subroutine fstr_eigen_init(fstrEIG)
Initial setting of eigen ca;culation.
subroutine fstr_setup_dflux(ctrl, counter, P)
Read in !DFLUX !
subroutine fstr_setup_post_phys_alloc(phys, NDOF, n_node, n_elem)
Initial setting of postprecessor.
subroutine fstr_solid_finalize(fstrSOLID)
Finalizer of fstr_solid.
subroutine fstr_setup_cflux(ctrl, counter, P)
Read in !CFLUX !
subroutine fstr_convert_contact_type(hecMESH)
Convert SURF-SURF contact to NODE-SURF contact !
subroutine fstr_setup_couple(ctrl, counter, P)
Read in !COUPLE !
subroutine fstr_solid_init(hecMESH, fstrSOLID)
Initializer of structure fstr_solid.
subroutine fstr_setup_step(ctrl, counter, P)
Read in !STEP !
subroutine fstr_dynamic_init(fstrDYNAMIC)
Initial setting of dynamic calculation.
subroutine fstr_setup_solid_nastran(ctrl, hecMESH, fstrSOLID)
subroutine fstr_setup_solver(ctrl, counter, P)
Read in !SOLVER !
subroutine fstr_setup_restart(ctrl, nout, version)
Read in !RESTART !
subroutine fstr_setup_cload(ctrl, counter, P)
Read in !CLOAD !
subroutine fstr_heat_init(fstrHEAT)
Initial setting of heat analysis.
subroutine fstr_element_init(hecMESH, fstrSOLID)
Initialize elements info in static calculation.
subroutine fstr_setup_output_sstype(ctrl, P)
Read in !OUTPUT_SSTYPE !
subroutine fstr_setup_write(ctrl, counter, P)
Read in !WRITE !
subroutine fstr_setup_eigen(ctrl, counter, P)
Read in !EIGEN !
subroutine fstr_setup_film(ctrl, counter, P)
Read in !FILM !
subroutine fstr_setup_solution(ctrl, counter, P)
Read in !SOLUTION !
subroutine fstr_setup_acceleration(ctrl, counter, P)
Read in !ACCELERATION !
subroutine fstr_setup_velocity(ctrl, counter, P)
Read in !VELOCITY !
subroutine fstr_setup_heat(ctrl, counter, P)
Read in !HEAT !
subroutine fstr_setup_temperature(ctrl, counter, P)
Read in !TEMPERATURE !
subroutine fstr_setup_dynamic(ctrl, counter, P)
Read in !DYNAMIC !
subroutine fstr_setup(cntl_filename, hecMESH, fstrPARAM, fstrSOLID, fstrEIG, fstrHEAT, fstrDYNAMIC, fstrCPL, fstrFREQ)
Read in and initialize control data !
integer function fstr_setup_orientation(ctrl, hecMESH, cnt, coordsys)
Read in !ORIENTATION.
subroutine fstr_setup_fixtemp(ctrl, counter, P)
Read in !FIXTEMP !
subroutine fstr_setup_reftemp(ctrl, counter, P)
Read in !REFTEMP !
subroutine fstr_setup_echo(ctrl, counter, P)
Read in !ECHO !
subroutine fstr_setup_post(ctrl, P)
subroutine fstr_expand_dload_array(array, old_size, new_size)
Read !FLOAD !
subroutine fstr_setup_sfilm(ctrl, counter, P)
Read in !SFILM !
subroutine fstr_dynamic_alloc(hecMESH, fstrDYNAMIC)
Initial setting of dynamic calculation.
subroutine fstr_setup_spring(ctrl, counter, P)
Read in !SPRING !
subroutine fstr_dynamic_finalize(fstrDYNAMIC)
Finalizer of fstr_solid.
subroutine fstr_setup_sflux(ctrl, counter, P)
Read in !SFLUX !
subroutine fstr_solid_alloc(hecMESH, fstrSOLID)
Initializer of structure fstr_solid.
This module defined coomon data and basic structures for analysis.
integer(kind=kint), parameter iutb
integer(kind=kint) myrank
PARALLEL EXECUTION.
integer(kind=kint), parameter kbcffstr
boundary condition file type (bcf)
real(kind=kreal), dimension(100) svrarray
integer(kind=kint), parameter kstdynamic
integer(kind=kint), parameter idbg
integer(kind=kint), parameter kel361fi
section control
integer(kind=kint) opsstype
integer(kind=kint), dimension(100) sviarray
SOLVER CONTROL.
integer(kind=kint), parameter kon
integer(kind=kint), parameter kel361ic
integer(kind=kint), parameter ilog
FILE HANDLER.
real(kind=kreal) dt
ANALYSIS CONTROL for NLGEOM and HEAT.
integer(kind=kint), parameter kststatic
integer(kind=kint), parameter kbcinitial
integer(kind=kint), parameter kcaalagrange
integer(kind=kint), parameter kststaticeigen
integer(kind=kint), parameter kstheat
real(kind=kreal), pointer ref_temp
REFTEMP.
integer(kind=kint), parameter kel361fbar
integer(kind=kint), parameter ksteigen
type(tinitialcondition), dimension(:), pointer, save g_initialcnd
logical paracontactflag
PARALLEL CONTACT FLAG.
This module manages step infomation.
subroutine fstr_init_outctrl(outctrl)
subroutine fstr_copy_outctrl(outctrl1, outctrl2)
subroutine fstr_ctrl_get_output(ctrl, outctrl, islog, res, visual, femap)
This module provide a function to fetch material properties from hecmw.
subroutine fstr_get_prop(hecMESH, shell_var, isect, ee, pp, rho, alpha, thick, n_totlyr, alpha_over_mu, beam_radius, beam_angle1, beam_angle2, beam_angle3, beam_angle4, beam_angle5, beam_angle6)
This module manages step infomation.
subroutine free_stepinfo(step)
Finalizer.
subroutine init_stepinfo(stepinfo)
Initializer.
subroutine init_aincparam(aincparam)
Initializer.
subroutine setup_stepinfo_starttime(stepinfos)
This module provides aux functions.
subroutine cross_product(v1, v2, vn)
This module summarizes all infomation of material properties.
integer(kind=kint), parameter m_youngs
integer(kind=kint), parameter m_beam_radius
integer(kind=kint), parameter viscoelastic
integer(kind=kint), parameter m_exapnsion
integer(kind=kint), parameter m_beam_angle6
integer(kind=kint), parameter elastic
integer(kind=kint), parameter m_beam_angle3
integer(kind=kint), parameter m_density
integer(kind=kint), parameter m_beam_angle4
integer(kind=kint), parameter m_poisson
integer(kind=kint), parameter m_beam_angle1
integer(kind=kint), parameter m_thick
integer(kind=kint), parameter m_beam_angle5
integer(kind=kint), parameter m_beam_angle2
integer(kind=kint), parameter m_alpha_over_mu
subroutine initmaterial(material)
Initializer.
This modules defines a structure to record history dependent parameter in static analysis.
subroutine fstr_init_gauss(gauss)
Initializer.
Data for coupling analysis.
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Package of data used by Lanczos eigenvalue solver.
Data for HEAT ANSLYSIS (fstrHEAT)
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Data for STATIC ANSLYSIS (fstrSOLID)
Package of all data needs to initilize.
output control such as output filename, output freqency etc.