FrontISTR  5.2.0
Large-scale structural analysis program with finit element method
fistr_main.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
5 module m_fstr_main
6 
7  use hecmw
8  use m_fstr
10  use m_fstr_setup
14  use m_static_echo
15  use m_heat_init
16  use m_heat_echo
17  use m_fstr_precheck
18  use m_fstr_rcap_io
20  use fstr_debug_dump
22 
23  type(hecmwst_local_mesh), save :: hecmesh
24  type(hecmwst_matrix), save :: hecmat
25  type(hecmwst_matrix), save :: conmat
26  type(fstr_solid), save :: fstrsolid
28  type(fstr_heat), save :: fstrheat
29  type(fstr_eigen), save :: fstreig
30  type(fstr_dynamic), save :: fstrdynamic
31  type(hecmwst_result_data), save :: fstrresult
32  type(fstr_couple), save :: fstrcpl
33  type(fstr_freqanalysis), save :: fstrfreq
34  character(len=HECMW_FILENAME_LEN) :: name_id
35 
36 contains
37 
38  subroutine fstr_main() bind(C,NAME='fstr_main')
39  implicit none
40  real(kind=kreal) :: t1, t2, t3
41 
42  t1=0.0d0; t2=0.0d0; t3=0.0d0
43 
44  ! =============== INITIALIZE ===================
45 
46  call hecmw_init
47  myrank = hecmw_comm_get_rank()
48  nprocs = hecmw_comm_get_size()
49 
50  t1 = hecmw_wtime()
51 
52  name_id = 'fstrMSH'
53  call hecmw_get_mesh( name_id , hecmesh )
54 
55  if( hecmesh%contact_pair%n_pair > 0 ) then
56  if( nprocs > 1 .and. &
57  hecmesh%hecmw_flag_partcontact /= hecmw_flag_partcontact_aggregate ) then
58  paracontactflag = .true.
59  endif
60  if( myrank == 0 ) then
61  print *,'paraContactFlag',paracontactflag
62  endif
63  endif
64 
66 
67  call fstr_init
68 
70 
71  t2 = hecmw_wtime()
72 
73  ! =============== ANALYSIS =====================
74 
75  select case( fstrpr%solution_type )
76  case( kststatic )
78  case( kstdynamic )
80  case( ksteigen )
82  case( kstheat )
84  case( kststaticeigen )
86  case( kstprecheck, kstnzprof )
87  call fstr_precheck( hecmesh, hecmat, fstrpr%solution_type )
88  end select
89 
90  t3 = hecmw_wtime()
91 
92  if(hecmesh%my_rank==0) then
93  write(*,*)
94  write(*,*) '===================================='
95  write(*,'(a,f10.2)') ' TOTAL TIME (sec) :', t3 - t1
96  write(*,'(a,f10.2)') ' pre (sec) :', t2 - t1
97  write(*,'(a,f10.2)') ' solve (sec) :', t3 - t2
98  write(*,*) '===================================='
99 
100  write(imsg,*) '===================================='
101  write(imsg,'(a,f10.2)') ' TOTAL TIME (sec) :', t3 - t1
102  write(imsg,'(a,f10.2)') ' pre (sec) :', t2 - t1
103  write(imsg,'(a,f10.2)') ' solve (sec) :', t3 - t2
104  write(imsg,*) '===================================='
105  endif
106 
107  ! =============== FINALIZE =====================
108 
110  call fstr_finalize()
111  call hecmw_dist_free(hecmesh)
112  call hecmw_finalize
113  if(hecmesh%my_rank==0) write(*,*) 'FrontISTR Completed !!'
114 
115  end subroutine fstr_main
116 
117  !=============================================================================!
119  !=============================================================================!
120 
121  subroutine fstr_init
122  implicit none
123 
124  ! set pointer to null
125  call hecmw_nullify_matrix ( hecmat )
126  call hecmw_nullify_matrix ( conmat )
127  call hecmw_nullify_result_data( fstrresult )
134  call fstr_init_file
135 
136  ! ---- default setting of global params ---
137  dt = 1
138  etime = 1
139  itmax = 20
140  eps = 1.0d-6
141 
142  ! ------- grobal pointer setting ----------
143  ref_temp => fstrpr%ref_temp
144  iecho => fstrpr%fg_echo
145  iresult => fstrpr%fg_result
146  ivisual => fstrpr%fg_visual
147 
148  ! for heat ...
149  ineutral => fstrpr%fg_neutral
150  irres => fstrpr%fg_irres
151  iwres => fstrpr%fg_iwres
152  nrres => fstrpr%nrres
153  nprint => fstrpr%nprint
154 
155  call hecmw_mat_con(hecmesh, hecmat)
156 
157  ! ------- initial value setting -------------
158  call fstr_mat_init ( hecmat )
160 
162  call fstr_eigen_init( fstreig )
163  call fstr_heat_init ( fstrheat )
165 
167  hecmat%NDOF = hecmesh%n_dof
168  if( kstheat == fstrpr%solution_type ) then
171  hecmat%NDOF = 1
172  endif
173  call hecmat_init( hecmat )
174 
175  end subroutine fstr_init
176 
177  !------------------------------------------------------------------------------
179  subroutine fstr_init_file
180  implicit none
181  character(len=HECMW_FILENAME_LEN) :: s, r
182  character(len=HECMW_FILENAME_LEN) :: stafileNAME
183  character(len=HECMW_FILENAME_LEN) :: logfileNAME
184  character(len=HECMW_FILENAME_LEN) :: msgfileNAME
185  character(len=HECMW_FILENAME_LEN) :: dbgfileNAME
186  integer :: stat, flag, limit, irank
187 
188  ! set file name --------------------------------
189  call hecmw_ctrl_is_subdir( flag, limit )
190  write(s,*) myrank
191  if( flag == 0 ) then
192  write( logfilename, '(a,a)') trim(adjustl(s)), '.log'
193  logfilename = adjustl(logfilename)
194  write( dbgfilename, '(a,a)') 'FSTR.dbg.', trim(adjustl(s))
195  dbgfilename = adjustl(dbgfilename)
196  else
197  if( nprocs > limit ) then
198  irank = myrank / limit
199  write(r,*) irank
200  write( logfilename, '(a,a,a,a,a)') 'LOG/TRUNK', trim(adjustl(r)), '/', trim(adjustl(s)), '.log'
201  logfilename = adjustl(logfilename)
202  call hecmw_ctrl_make_subdir( logfilename, stat )
203  if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
204  write( dbgfilename, '(a,a,a,a,a)') 'DBG/TRUNK', trim(adjustl(r)), '/', 'FSTR.dbg.', trim(adjustl(s))
205  dbgfilename = adjustl(dbgfilename)
206  call hecmw_ctrl_make_subdir( dbgfilename, stat )
207  if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
208  else
209  write( logfilename, '(a,a,a)') 'LOG/', trim(adjustl(s)), '.log'
210  logfilename = adjustl(logfilename)
211  call hecmw_ctrl_make_subdir( logfilename, stat )
212  if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
213  write( dbgfilename, '(a,a,a)') 'DBG/', 'FSTR.dbg.', trim(adjustl(s))
214  dbgfilename = adjustl(dbgfilename)
215  call hecmw_ctrl_make_subdir( dbgfilename, stat )
216  if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
217  endif
218  endif
219  stafilename = 'FSTR.sta'
220  msgfilename = 'FSTR.msg'
221 
222  ! open & opening message out -------------------
223  ! MSGFILE
224  if( myrank == 0) then
225  open(imsg, file=msgfilename, status='replace', iostat=stat)
226  if( stat /= 0 ) then
227  call fstr_setup_util_err_stop( '### Cannot open message file :'//msgfilename )
228  endif
229  write(imsg,*) ':========================================:'
230  write(imsg,*) ':** BEGIN FSTR Structural Analysis **:'
231  write(imsg,*) ':========================================:'
232  write(imsg,*) ' Total no. of processors: ',nprocs
233  write(imsg,*)
234  write(imsg,*)
235  write(imsg,*)
236  write(imsg,*) ' * STAGE Initialization and input **'
237  endif
238 
239  ! LOGFILE & STAFILE
240  open (ilog, file = logfilename, status = 'replace', iostat=stat )
241  if( stat /= 0 ) then
242  call fstr_setup_util_err_stop( '### Cannot open log file :'//logfilename )
243  endif
244 
245  if( myrank == 0 ) then
246  open (ista,file = stafilename, status = 'replace', iostat=stat )
247  write(ista,'(''####''a80)') stafilename
248  if( stat /= 0 ) then
249  call fstr_setup_util_err_stop( '### Cannot open status file :'//stafilename )
250  endif
251  endif
252 
253  open (idbg,file = dbgfilename, status = 'replace')
254  write(idbg,'(''####''a80)') dbgfilename
255  if( stat /= 0 ) then
256  call fstr_setup_util_err_stop( '### Cannot open debug file :'//dbgfilename )
257  endif
258  end subroutine fstr_init_file
259 
260  !------------------------------------------------------------------------------
263  implicit none
264  character(len=HECMW_FILENAME_LEN) :: cntfileNAME
265 
266  name_id='fstrCNT'
267  call hecmw_ctrl_get_control_file( name_id, cntfilename )
268 
269  ! loading boundary conditions etc. from fstr control file or nastran mesh file
270  ! and setup parameters ...
271  svrarray(:) = hecmat%Rarray(:)
272  sviarray(:) = hecmat%Iarray(:)
273 
275 
276  hecmat%Rarray(:) = svrarray(:)
277  hecmat%Iarray(:) = sviarray(:)
278 
279  if( myrank == 0) write(*,*) 'fstr_setup: OK'
280  write(ilog,*) 'fstr_setup: OK'
281  call flush(6)
282 
283  end subroutine fstr_init_condition
284 
285  !=============================================================================!
287  !=============================================================================!
288 
290  implicit none
291 
292  if( iecho.eq.1 ) call fstr_echo(hecmesh)
293 
294  if(myrank .EQ. 0) then
295  write(imsg,*)
296  write(imsg,*)
297  write(imsg,*)
298  endif
299 
300  if( fstrpr%nlgeom ) then
301  if( myrank == 0) write(imsg,*) ' *** STAGE Non Linear static analysis **'
302  else
303  if( myrank == 0 ) write(imsg,*) ' *** STAGE Linear static analysis **'
304  endif
305 
306  if( paracontactflag ) then
308  else
310  endif
311 
313 
314  end subroutine fstr_static_analysis
315 
316  !=============================================================================!
318  !=============================================================================!
319 
321  use hecmw
322  use m_fstr
323  implicit none
324 
325  if( iecho.eq.1 ) call fstr_echo(hecmesh)
326  if(myrank .EQ. 0) then
327  write(imsg,*)
328  write(imsg,*)
329  write(imsg,*)
330  write(imsg,*) ' *** STAGE Eigenvalue analysis **'
331  endif
332 
334 
335  end subroutine fstr_eigen_analysis
336 
337  !=============================================================================!
339  !=============================================================================!
340 
342  implicit none
343 
344  if( iecho.eq.1 ) call heat_echo(fstrpr,hecmesh,fstrheat)
345  if(myrank .EQ. 0) then
346  write(imsg,*)
347  write(imsg,*)
348  write(imsg,*)
349  write(imsg,*) ' *** STAGE Heat analysis **'
350  endif
351 
353 
354  end subroutine fstr_heat_analysis
355 
356  !=============================================================================!
358  !=============================================================================!
359 
361  implicit none
362 
363  if( iecho.eq.1 ) call fstr_echo(hecmesh)
364 
365  if(myrank == 0) then
366  write(imsg,*)
367  write(imsg,*)
368  write(imsg,*)
369  if( fstrpr%nlgeom ) then
370  write(imsg,*) ' *** STAGE Nonlinear dynamic analysis **'
371  else
372  write(imsg,*) ' *** STAGE Linear dynamic analysis **'
373  endif
374  endif
375 
376  if( paracontactflag ) then
379  conmat )
380  else
383  endif
384 
385  end subroutine fstr_dynamic_analysis
386 
387  !=============================================================================!
389  !=============================================================================!
390 
392  implicit none
393 
394  if( iecho==1 ) call fstr_echo(hecmesh)
395 
396  if(myrank == 0) then
397  write(imsg,*)
398  write(imsg,*)
399  write(imsg,*)
400  write(imsg,*) ' *** STAGE Static -> Eigen analysis **'
401  write(*,*) ' *** STAGE Static -> Eigen analysis **'
402  write(imsg,*)
403  write(imsg,*) ' *** Stage 1: Nonlinear dynamic analysis **'
404  write(*,*) ' *** Stage 1: Nonlinear dynamic analysis **'
405  endif
406 
408 
409  if(myrank == 0) then
410  write(imsg,*)
411  write(imsg,*) ' *** Stage 2: Eigenvalue analysis **'
412  write(*,*)
413  write(*,*) ' *** Stage 2: Eigenvalue analysis **'
414  endif
415 
417 
419 
420  end subroutine fstr_static_eigen_analysis
421 
422  !=============================================================================!
424  !=============================================================================!
425 
426  subroutine fstr_finalize
427  implicit none
428 
429  if( myrank == 0 ) then
430  write(imsg,*)
431  write(imsg,*)
432  write(imsg,*)
433  write(imsg,*) ':========================================:'
434  write(imsg,*) ':** END of FSTR **:'
435  write(imsg,*) ':========================================:'
436  close(imsg)
437  close(ista)
438  endif
439 
441  call hecmat_finalize( hecmat )
442 
443  close(ilog)
444  close(idbg)
445  end subroutine fstr_finalize
446 
447 end module m_fstr_main
void hecmw_ctrl_is_subdir(int *flag, int *limit)
void hecmw_ctrl_make_subdir(char *filename, int *err, int len)
This module contains functions to print out calculation settings.
This module provides functions of reconstructing.
This module contains subroutines controlling dynamic calculation.
subroutine fstr_solve_dynamic(hecMESH, hecMAT, fstrSOLID, fstrEIG, fstrDYNAMIC, fstrRESULT, fstrPARAM, fstrCPL, fstrFREQ, fstrMAT, conMAT)
Master subroutine for dynamic analysis.
Definition: hecmw.f90:6
type(hecmwst_result_data), save fstrresult
Definition: fistr_main.f90:31
subroutine fstr_dynamic_analysis
Master subroutine of dynamic analysis !
Definition: fistr_main.f90:361
type(hecmwst_matrix), save hecmat
Definition: fistr_main.f90:24
subroutine fstr_static_eigen_analysis
Master subroutine of static -> eigen anaylsis !
Definition: fistr_main.f90:392
subroutine fstr_init
Initializer !
Definition: fistr_main.f90:122
subroutine fstr_heat_analysis
Master subroutine of heat analysis !
Definition: fistr_main.f90:342
type(hecmwst_local_mesh), save hecmesh
Definition: fistr_main.f90:23
subroutine fstr_init_condition
Read in control file and do all preparation.
Definition: fistr_main.f90:263
type(fstr_solid), save fstrsolid
Definition: fistr_main.f90:26
type(fstr_heat), save fstrheat
Definition: fistr_main.f90:28
subroutine fstr_static_analysis
Master subroutine of linear/nonlinear static analysis !
Definition: fistr_main.f90:290
character(len=hecmw_filename_len) name_id
Definition: fistr_main.f90:34
subroutine fstr_finalize
Finalizer !
Definition: fistr_main.f90:427
type(fstr_dynamic), save fstrdynamic
Definition: fistr_main.f90:30
subroutine fstr_main()
Definition: fistr_main.f90:39
type(fstr_couple), save fstrcpl
Definition: fistr_main.f90:32
type(fstrst_matrix_contact_lagrange), save fstrmat
Definition: fistr_main.f90:27
subroutine fstr_init_file
Open all files preparing calculation.
Definition: fistr_main.f90:180
type(fstr_freqanalysis), save fstrfreq
Definition: fistr_main.f90:33
type(hecmwst_matrix), save conmat
Definition: fistr_main.f90:25
subroutine fstr_eigen_analysis
Master subroutine of eigen analysis !
Definition: fistr_main.f90:321
type(fstr_eigen), save fstreig
Definition: fistr_main.f90:29
This module provides function to check input data of IFSTR solver.
subroutine fstr_precheck(hecMESH, hecMAT, soltype)
subroutine, public fstr_rcap_finalize(fstrPARAM, fstrCPL)
subroutine, public fstr_rcap_initialize(hecMESH, fstrPARAM, fstrCPL)
This module provides functions to read in data from control file and do neccessary preparation for fo...
Definition: fstr_setup.f90:7
subroutine fstr_eigen_init(fstrEIG)
Initial setting of eigen ca;culation.
subroutine fstr_solid_finalize(fstrSOLID)
Finalizer of fstr_solid.
subroutine fstr_solid_init(hecMESH, fstrSOLID)
Initializer of structure fstr_solid.
Definition: fstr_setup.f90:895
subroutine fstr_dynamic_init(fstrDYNAMIC)
Initial setting of dynamic calculation.
subroutine fstr_heat_init(fstrHEAT)
Initial setting of heat analysis.
subroutine fstr_setup(cntl_filename, hecMESH, fstrPARAM, fstrSOLID, fstrEIG, fstrHEAT, fstrDYNAMIC, fstrCPL, fstrFREQ)
Read in and initialize control data !
Definition: fstr_setup.f90:44
This module provides a function to control eigen analysis.
subroutine fstr_solve_eigen(hecMESH, hecMAT, fstrEIG, fstrSOLID, fstrRESULT, fstrPARAM, fstrMAT)
solve eigenvalue probrem
This module provides a function to control heat analysis.
subroutine fstr_solve_heat(hecMESH, hecMAT, fstrRESULT, fstrPARAM, fstrHEAT)
This module provides main suboruitne for nonliear calculation.
subroutine fstr_solve_nlgeom(hecMESH, hecMAT, fstrSOLID, fstrMAT, fstrPARAM, conMAT)
This module provides main suborutine for nonlinear calculation.
This module defined coomon data and basic structures for analysis.
Definition: m_fstr.f90:15
integer(kind=kint), pointer iresult
Definition: m_fstr.f90:106
subroutine hecmat_finalize(hecMAT)
Definition: m_fstr.f90:891
subroutine fstr_nullify_fstr_couple(C)
Definition: m_fstr.f90:782
real(kind=kreal) eps
Definition: m_fstr.f90:126
integer(kind=kint) myrank
PARALLEL EXECUTION.
Definition: m_fstr.f90:80
subroutine fstr_param_init(fstrPARAM, hecMESH)
Initializer of structure fstr_param.
Definition: m_fstr.f90:949
integer(kind=kint), parameter imsg
Definition: m_fstr.f90:94
real(kind=kreal), dimension(100) svrarray
Definition: m_fstr.f90:102
integer(kind=kint), parameter kstdynamic
Definition: m_fstr.f90:40
integer(kind=kint), pointer ineutral
Definition: m_fstr.f90:108
subroutine fstr_nullify_fstr_heat(H)
Definition: m_fstr.f90:696
real(kind=kreal) etime
Definition: m_fstr.f90:124
integer(kind=kint), parameter idbg
Definition: m_fstr.f90:95
integer(kind=kint), dimension(100) sviarray
SOLVER CONTROL.
Definition: m_fstr.f90:101
subroutine fstr_mat_init(hecMAT)
Initializer of structure hecmwST_matrix.
Definition: m_fstr.f90:793
integer(kind=kint) itmax
Definition: m_fstr.f90:125
subroutine fstr_nullify_fstr_eigen(E)
Definition: m_fstr.f90:775
integer(kind=kint) nprocs
Definition: m_fstr.f90:81
integer(kind=kint), pointer iwres
Definition: m_fstr.f90:110
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:91
integer(kind=kint), pointer nprint
Definition: m_fstr.f90:112
real(kind=kreal) dt
ANALYSIS CONTROL for NLGEOM and HEAT.
Definition: m_fstr.f90:123
integer(kind=kint), pointer nrres
Definition: m_fstr.f90:111
integer(kind=kint), parameter kststatic
Definition: m_fstr.f90:37
integer(kind=kint), parameter kstprecheck
solution type (st)
Definition: m_fstr.f90:36
subroutine hecmat_init(hecMAT)
Definition: m_fstr.f90:833
integer(kind=kint), parameter kststaticeigen
Definition: m_fstr.f90:42
integer(kind=kint), parameter kstheat
Definition: m_fstr.f90:39
integer(kind=kint), parameter ista
Definition: m_fstr.f90:92
real(kind=kreal), pointer ref_temp
REFTEMP.
Definition: m_fstr.f90:120
integer(kind=kint), parameter kstnzprof
Definition: m_fstr.f90:43
integer(kind=kint), pointer irres
Definition: m_fstr.f90:109
integer(kind=kint), pointer iecho
FLAG for ECHO/RESULT/POST.
Definition: m_fstr.f90:105
type(fstr_param), target fstrpr
GLOBAL VARIABLE INITIALIZED IN FSTR_SETUP.
Definition: m_fstr.f90:190
subroutine fstr_nullify_fstr_param(P)
NULL POINTER SETTING TO AVOID RUNTIME ERROR.
Definition: m_fstr.f90:627
integer(kind=kint), parameter ksteigen
Definition: m_fstr.f90:38
integer(kind=kint), pointer ivisual
Definition: m_fstr.f90:107
subroutine fstr_nullify_fstr_solid(S)
Definition: m_fstr.f90:641
subroutine fstr_nullify_fstr_dynamic(DY)
Definition: m_fstr.f90:750
logical paracontactflag
PARALLEL CONTACT FLAG.
Definition: m_fstr.f90:84
ECHO for HEAT solver.
Definition: heat_echo.f90:6
subroutine heat_echo(p, hecMESH, fstrHEAT)
Definition: heat_echo.f90:10
This module provides functions to initialize heat analysis.
Definition: heat_init.f90:6
subroutine heat_init_material(hecMESH, fstrHEAT)
Definition: heat_init.f90:159
subroutine heat_init_amplitude(hecMESH, fstrHEAT)
Definition: heat_init.f90:75
HECMW to FSTR Mesh Data Converter. Convering Conectivity of Element Type 232, 342 and 352.
subroutine hecmw2fstr_mesh_conv(hecMESH)
This module provide a function to ECHO for IFSTR solver.
Definition: static_echo.f90:6
subroutine fstr_echo(hecMESH)
ECHO for IFSTR solver.
Definition: static_echo.f90:14
Structure for Lagrange multiplier-related part of stiffness matrix (Lagrange multiplier-related matri...
Data for coupling analysis.
Definition: m_fstr.f90:580
Data for DYNAMIC ANSLYSIS (fstrDYNAMIC)
Definition: m_fstr.f90:473
Package of data used by Lanczos eigenvalue solver.
Definition: m_fstr.f90:562
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.f90:394