FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
heat_echo.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
6 module m_heat_echo
7 contains
8 
9  subroutine heat_echo ( p, hecMESH, fstrHEAT )
10 
11  use m_fstr
12  use m_hecmw2fstr_mesh_conv
13 
14  implicit none
15 
16  type(fstr_param) :: p
17  type(hecmwst_local_mesh) :: hecMESH
18  type(fstr_heat) :: fstrHEAT
19 
20  !** Local variables
21  integer(kind=kint) :: i, j, itype, is, iE, ic_type, nn, icel, isect, mid, ic, im, jm, jS, jE, kc, km
22  real(kind=kreal) :: val, temp, aa, bb, time, x, y, z
23  integer(kind=kint) :: ig1, iS0, iE0, ik, in, inod, nid
24  integer(kind=kint) :: nids(20)
25 
26 
27  !C +-------------------------------+
28  !C | GLOBAL PARAMETERS |
29  !C +-------------------------------+
30 
31  write(ilog,*) 'global parameters ***********'
32  write(ilog,*)
33  write(ilog,*) 'IECHO ',iecho
34  write(ilog,*) 'IRESULT ',iresult
35  write(ilog,*) 'IVISUAL ',ivisual
36  write(ilog,*)
37  write(ilog,*) 'for heat ...'
38  write(ilog,*) 'INEUTRAL ', ineutral
39  write(ilog,*) 'IRRES ', irres
40  write(ilog,*) 'IWRES ', iwres
41  write(ilog,*) 'NRRES ', nrres
42  write(ilog,*) 'NPRINT ', nprint
43  write(ilog,*)
44  write(ilog,*) 'REF_TEMP ', ref_temp
45  write(ilog,*)
46  write(ilog,*) 'ANALYSIS CONTROL for HEAT'
47  write(ilog,*) 'DT ',dt
48  write(ilog,*) 'ETIME ',etime
49  write(ilog,*) 'ITMAX ',itmax
50  write(ilog,*) 'EPS ',eps
51 
52  !C +-------------------------------+
53  !C | fstrPARAM |
54  !C +-------------------------------+
55 
56  write(ilog,*) 'fstrPARAM ********************'
57  write(ilog,*)
58  write(ilog,*) 'solution_type ',p%solution_type
59  write(ilog,*) 'solver_method ',p%solver_method
60  write(ilog,*)
61  write(ilog,*) '!!STATIC !HEAT'
62  write(ilog,*) p%analysis_n
63  if( associated( p%dtime)) write(ilog,*) 'dtime ', p%dtime
64  if( associated( p%etime)) write(ilog,*) 'etime ', p%etime
65  if( associated( p%dtmin)) write(ilog,*) 'dtmin ', p%dtmin
66  if( associated( p%delmax)) write(ilog,*) 'delmax ', p%delmax
67  if( associated( p%itmax)) write(ilog,*) 'itmax ', p%itmax
68  if( associated( p%eps)) write(ilog,*) 'eps ', p%eps
69  write(ilog,*) 'ref_temp ', p%ref_temp
70  write(ilog,*)
71  write(ilog,*) 'output control'
72  write(ilog,*) 'fg_echo ', p%fg_echo
73  write(ilog,*) 'fg_result ', p%fg_result
74  write(ilog,*) 'fg_visual ', p%fg_visual
75  write(ilog,*)
76  write(ilog,*) 'for heat ...'
77  write(ilog,*) 'fg_neutral ', p%fg_neutral
78  write(ilog,*) 'fg_irres ', p%fg_irres
79  write(ilog,*) 'fg_iwres ', p%fg_iwres
80  write(ilog,*) 'nrres ', p%nrres
81  write(ilog,*) 'nprint ', p%nprint
82  write(ilog,*)
83  write(ilog,*) 'index table for global node ID sorting'
84  write(ilog,*) 'n_node ', p%n_node
85  if( associated( p%global_local_ID)) write(ilog,*) 'global_local_ID ', p%global_local_ID
86 
87  !C +-------------------------------+
88  !C | NODE |
89  !C +-------------------------------+
90 
91  write(ilog,*)
92  write(ilog,*) '### Nodes'
93  write(ilog,*) '### Number of nodes',hecmesh%n_node
94  write(ilog,*) 'ID X Y Z'
95  do i=1,hecmesh%n_node
96  nid = hecmesh%global_node_ID(i)
97  x = hecmesh%node(3*i-2)
98  y = hecmesh%node(3*i-1)
99  z = hecmesh%node(3*i)
100  write(ilog,*) nid,x,y,z
101  enddo
102 
103 
104  !C +-------------------------------+
105  !C | ELEMENT |
106  !C +-------------------------------+
107 
108  call fstr2hecmw_mesh_conv( hecmesh )
109  write(ilog,*)
110  write(ilog,*) '### Elements'
111 
112  do itype= 1, hecmesh%n_elem_type
113  is= hecmesh%elem_type_index(itype-1) + 1
114  ie= hecmesh%elem_type_index(itype )
115  ic_type= hecmesh%elem_type_item(itype)
116 
117  !C** Set number of nodes
118  nn = hecmw_get_max_node(ic_type)
119  !C element loop
120  do icel= is, ie
121  !C** node ID
122  is= hecmesh%elem_node_index(icel-1)
123  do j=1,nn
124  if( hecmesh%n_refine > 0 ) then
125  nids(j)= hecmesh%elem_node_item (is+j)
126  else
127  nids(j)= hecmesh%global_node_ID( hecmesh%elem_node_item (is+j))
128  endif
129  enddo
130  !C** section ID
131  isect= hecmesh%section_ID(icel)
132  !C** material ID
133  mid= hecmesh%section%sect_mat_ID_item(isect)
134  write(ilog,*) '### Element ID=',hecmesh%global_elem_ID(icel)
135  write(ilog,*) ic_type,isect,mid
136  write(ilog,*) (nids(j),j=1,nn)
137  enddo
138  enddo
139  call hecmw2fstr_mesh_conv(hecmesh)
140  !C +-------------------------------+
141  !C | Material |
142  !C +-------------------------------+
143 
144  write(ilog,*)
145  write(ilog,*) '### Material'
146 
147  ic = 0
148  do im = 1, hecmesh%material%n_mat
149  write(ilog,*)
150  write(ilog,*) ' Material No. =', im
151  do jm = 1, 3
152  ic = ic + 1
153  js= hecmesh%material%mat_TABLE_index(ic-1) + 1
154  je= hecmesh%material%mat_TABLE_index(ic )
155  nn= je - js + 1
156  if (jm.eq.1) write(ilog,*) ' Density Temperature functionA functionB'
157  if (jm.eq.2) write(ilog,*) ' Specific heat Temperature functionA functionB'
158  if (jm.eq.3) write(ilog,*) ' Conductivity Temperature functionA functionB'
159  kc = 0
160  do km = js, je
161  kc = kc + 1
162  val = hecmesh%material%mat_VAL (km)
163  temp = hecmesh%material%mat_TEMP(km)
164  if (jm.eq.1) aa = fstrheat%RHOfuncA(im,kc)
165  if (jm.eq.1) bb = fstrheat%RHOfuncB(im,kc)
166  if (jm.eq.2) aa = fstrheat%CPfuncA(im,kc)
167  if (jm.eq.2) bb = fstrheat%CPfuncB(im,kc)
168  if (jm.eq.3) aa = fstrheat%CONDfuncA(im,kc)
169  if (jm.eq.3) bb = fstrheat%CONDfuncB(im,kc)
170  write(ilog,'(1p4e13.4)') val,temp,aa,bb
171  enddo
172  if (jm.eq.1) aa = fstrheat%RHOfuncA(im,kc+1)
173  if (jm.eq.1) bb = fstrheat%RHOfuncB(im,kc+1)
174  if (jm.eq.2) aa = fstrheat%CPfuncA(im,kc+1)
175  if (jm.eq.2) bb = fstrheat%CPfuncB(im,kc+1)
176  if (jm.eq.3) aa = fstrheat%CONDfuncA(im,kc+1)
177  if (jm.eq.3) bb = fstrheat%CONDfuncB(im,kc+1)
178  write(ilog,'(26x,1p2e13.4)') aa,bb
179  enddo
180  enddo
181 
182  !C +-------------------------------+
183  !C | NODE GROUP |
184  !C +-------------------------------+
185 
186  write(ilog,*)
187  write(ilog,*) '### Ngroup'
188 
189  do ig1= 1, hecmesh%node_group%n_grp
190  write(ilog,*)
191  write(ilog,'(a80)') hecmesh%node_group%grp_name(ig1)
192  is0= hecmesh%node_group%grp_index(ig1-1) + 1
193  ie0= hecmesh%node_group%grp_index(ig1 )
194  do ik= is0, ie0
195  in = hecmesh%node_group%grp_item(ik)
196  write(ilog,*) in
197  enddo
198  enddo
199 
200  !C +-------------------------------+
201  !C | ELEMENT GROUP |
202  !C +-------------------------------+
203 
204  write(ilog,*)
205  write(ilog,*) '### Egroup'
206 
207  do ig1= 1, hecmesh%elem_group%n_grp
208  write(ilog,*)
209  write(ilog,'(a80)') hecmesh%elem_group%grp_name(ig1)
210  is0= hecmesh%elem_group%grp_index(ig1-1) + 1
211  ie0= hecmesh%elem_group%grp_index(ig1 )
212  do ik= is0, ie0
213  in = hecmesh%elem_group%grp_item(ik)
214  write(ilog,*) in
215  enddo
216  enddo
217 
218  !C +-------------------------------+
219  !C | BOUNDARY |
220  !C +-------------------------------+
221 
222  write(ilog,*)
223  write(ilog,*) '### Boundary'
224 
225  write(ilog,*) ' T_FIX_tot :', fstrheat%T_FIX_tot
226  write(ilog,*) ' No./ NID/ amp/ TEMP-BOUNDARY '
227  do i = 1, fstrheat%T_FIX_tot
228  inod = hecmesh%global_node_ID( fstrheat%T_FIX_node(i) )
229  write(ilog,'(2i10,i5,1PE15.7)') i, inod, fstrheat%T_FIX_ampl(i) &
230  , fstrheat%T_FIX_val (i)
231  enddo
232 
233  write(ilog,*) ' Q_NOD_tot :', fstrheat%Q_NOD_tot
234  write(ilog,*) ' No./ NID/ amp/ Q-POINT '
235  do i = 1, fstrheat%Q_NOD_tot
236  in = hecmesh%global_node_ID( fstrheat%Q_NOD_node(i) )
237  write(ilog,'(2i10,i5,1PE15.7)') i, inod, fstrheat%Q_NOD_ampl(i) &
238  , fstrheat%Q_NOD_val (i)
239  enddo
240 
241  write(ilog,*) ' Q_VOL_tot :', fstrheat%Q_VOL_tot
242  write(ilog,*) ' No./ EID/ SID/ amp/ Q-VOL '
243  do i = 1, fstrheat%Q_VOL_tot
244  ie = hecmesh%global_elem_ID( fstrheat%Q_VOL_elem(i) )
245  write(ilog,'(2i10,i5,1PE15.7)') i, ie, fstrheat%Q_VOL_ampl(i) &
246  , fstrheat%Q_VOL_val (i)
247  enddo
248 
249  write(ilog,*) ' Q_SUF_tot :', fstrheat%Q_SUF_tot
250  write(ilog,*) ' No./ EID/ SID/ amp/ Q-SURF '
251  do i = 1, fstrheat%Q_SUF_tot
252  ie = hecmesh%global_elem_ID( fstrheat%Q_SUF_elem(i) )
253  write(ilog,'(2i10,2i5,1PE15.7)') i, ie, fstrheat%Q_SUF_surf(i) &
254  , fstrheat%Q_SUF_ampl(i), fstrheat%Q_SUF_val (i)
255 
256  enddo
257 
258  write(ilog,*) ' H_SUF_tot :', fstrheat%H_SUF_tot
259  write(ilog,*) ' No./ EID/ SID/ H_amp/ T_amp/ HH/ Sink/ '
260  do i = 1, fstrheat%H_SUF_tot
261  ie = hecmesh%global_elem_ID( fstrheat%H_SUF_elem(i) )
262  write(ilog,'(2i10,3i5,1P2E15.7)') i, ie, fstrheat%H_SUF_surf(i) &
263  , fstrheat%H_SUF_ampl(i,1), fstrheat%H_SUF_ampl(i,2) &
264  , fstrheat%H_SUF_val (i,1), fstrheat%H_SUF_val (i,2)
265  enddo
266 
267  write(ilog,*) ' R_SUF_tot :', fstrheat%R_SUF_tot
268  write(ilog,*) ' No./ EID/ SID/ R_amp/ T_amp/ RR/ Sink/ '
269  do i = 1, fstrheat%R_SUF_tot
270  ie = hecmesh%global_elem_ID( fstrheat%R_SUF_elem(i) )
271  write(ilog,'(2i10,3i5,1P2E15.7)') i, ie, fstrheat%R_SUF_surf(i) &
272  , fstrheat%R_SUF_ampl(i,1), fstrheat%R_SUF_ampl(i,2) &
273  , fstrheat%R_SUF_val (i,1), fstrheat%R_SUF_val (i,2)
274  enddo
275 
276  !C +-------------------------------+
277  !C | Amplitude |
278  !C +-------------------------------+
279 
280  write(ilog,*)
281  write(ilog,*) '### Amplitude'
282 
283  write(ilog,*) ' AMPLITUDEtot :', fstrheat%AMPLITUDEtot
284  do i = 1, fstrheat%AMPLITUDEtot
285  nn = fstrheat%AMPLtab(i)
286  write(ilog,'(2i5,a,a10)') i, nn,' : name=', hecmesh%amp%amp_name(i)
287 
288  do j = 1, nn
289  time = fstrheat%AMPLtime(i,j)
290  val = fstrheat%AMPL (i,j)
291  aa = fstrheat%AMPLfuncA(i,j)
292  bb = fstrheat%AMPLfuncB(i,j)
293  write(ilog,'(i5,1p4e12.4)') j,time,val,aa,bb
294  enddo
295  aa = fstrheat%AMPLfuncA(i,nn+1)
296  bb = fstrheat%AMPLfuncB(i,nn+1)
297  write(ilog,'(i5,1p4e12.4)') nn+1,time,val,aa,bb
298 
299  enddo
300 
301  end subroutine heat_echo
302 end module m_heat_echo
m_fstr::iecho
integer(kind=kint), pointer iecho
FLAG for ECHO/RESULT/POST.
Definition: m_fstr.f90:121
m_fstr::ineutral
integer(kind=kint), pointer ineutral
Definition: m_fstr.f90:124
m_fstr::itmax
integer(kind=kint) itmax
Definition: m_fstr.f90:141
m_fstr::fstr_heat
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.f90:425
m_fstr::fstr_param
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.f90:154
m_hecmw2fstr_mesh_conv::fstr2hecmw_mesh_conv
subroutine fstr2hecmw_mesh_conv(hecMESH)
Definition: hecmw2fstr_mesh_conv.f90:27
m_fstr::eps
real(kind=kreal) eps
Definition: m_fstr.f90:142
m_fstr::dt
real(kind=kreal) dt
ANALYSIS CONTROL for NLGEOM and HEAT.
Definition: m_fstr.f90:139
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.f90:15
m_hecmw2fstr_mesh_conv::hecmw2fstr_mesh_conv
subroutine hecmw2fstr_mesh_conv(hecMESH)
Definition: hecmw2fstr_mesh_conv.f90:15
m_fstr::ivisual
integer(kind=kint), pointer ivisual
Definition: m_fstr.f90:123
m_fstr::ref_temp
real(kind=kreal), pointer ref_temp
REFTEMP.
Definition: m_fstr.f90:136
m_fstr::iresult
integer(kind=kint), pointer iresult
Definition: m_fstr.f90:122
m_fstr::iwres
integer(kind=kint), pointer iwres
Definition: m_fstr.f90:126
m_hecmw2fstr_mesh_conv
HECMW to FSTR Mesh Data Converter. Converting Connectivity of Element Type 232, 342 and 352.
Definition: hecmw2fstr_mesh_conv.f90:8
m_fstr::irres
integer(kind=kint), pointer irres
Definition: m_fstr.f90:125
m_fstr::nrres
integer(kind=kint), pointer nrres
Definition: m_fstr.f90:127
m_heat_echo::heat_echo
subroutine heat_echo(p, hecMESH, fstrHEAT)
Definition: heat_echo.f90:10
m_fstr::etime
real(kind=kreal) etime
Definition: m_fstr.f90:140
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.f90:107
m_fstr::nprint
integer(kind=kint), pointer nprint
Definition: m_fstr.f90:128
m_heat_echo
ECHO for HEAT solver.
Definition: heat_echo.f90:6