FrontISTR  6.0.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  !C +-------------------------------+
27  !C | fstrPARAM |
28  !C +-------------------------------+
29 
30  write(ilog,*) 'fstrPARAM ********************'
31  write(ilog,*)
32  write(ilog,*) 'solution_type ',p%solution_type
33  write(ilog,*) 'solver_method ',p%solver_method
34  write(ilog,*)
35  write(ilog,*) '!!STATIC !HEAT'
36  write(ilog,*) p%analysis_n
37  if( associated( p%dtime)) write(ilog,*) 'dtime ', p%dtime
38  if( associated( p%etime)) write(ilog,*) 'etime ', p%etime
39  if( associated( p%dtmin)) write(ilog,*) 'dtmin ', p%dtmin
40  if( associated( p%delmax)) write(ilog,*) 'delmax ', p%delmax
41  if( associated( p%itmax)) write(ilog,*) 'itmax ', p%itmax
42  if( associated( p%eps)) write(ilog,*) 'eps ', p%eps
43  write(ilog,*) 'ref_temp ', p%ref_temp
44  write(ilog,*)
45  write(ilog,*) 'output control'
46  write(ilog,*) 'fg_echo ', p%fg_echo
47  write(ilog,*) 'fg_result ', p%fg_result
48  write(ilog,*) 'fg_visual ', p%fg_visual
49  write(ilog,*)
50  write(ilog,*) 'for heat ...'
51  write(ilog,*) 'fg_neutral ', p%fg_neutral
52  write(ilog,*) 'fg_irres ', p%fg_irres
53  write(ilog,*) 'fg_iwres ', p%fg_iwres
54  write(ilog,*) 'nrres ', p%nrres
55  write(ilog,*) 'nprint ', p%nprint
56  write(ilog,*)
57  write(ilog,*) 'index table for global node ID sorting'
58  write(ilog,*) 'n_node ', p%n_node
59  if( associated( p%global_local_ID)) write(ilog,*) 'global_local_ID ', p%global_local_ID
60 
61  !C +-------------------------------+
62  !C | NODE |
63  !C +-------------------------------+
64 
65  write(ilog,*)
66  write(ilog,*) '### Nodes'
67  write(ilog,*) '### Number of nodes',hecmesh%n_node
68  write(ilog,*) 'ID X Y Z'
69  do i=1,hecmesh%n_node
70  nid = hecmesh%global_node_ID(i)
71  x = hecmesh%node(3*i-2)
72  y = hecmesh%node(3*i-1)
73  z = hecmesh%node(3*i)
74  write(ilog,*) nid,x,y,z
75  enddo
76 
77 
78  !C +-------------------------------+
79  !C | ELEMENT |
80  !C +-------------------------------+
81 
82  call fstr2hecmw_mesh_conv( hecmesh )
83  write(ilog,*)
84  write(ilog,*) '### Elements'
85 
86  do itype= 1, hecmesh%n_elem_type
87  is= hecmesh%elem_type_index(itype-1) + 1
88  ie= hecmesh%elem_type_index(itype )
89  ic_type= hecmesh%elem_type_item(itype)
90 
91  !C** Set number of nodes
92  nn = hecmw_get_max_node(ic_type)
93  !C element loop
94  do icel= is, ie
95  !C** node ID
96  is= hecmesh%elem_node_index(icel-1)
97  do j=1,nn
98  if( hecmesh%n_refine > 0 ) then
99  nids(j)= hecmesh%elem_node_item (is+j)
100  else
101  nids(j)= hecmesh%global_node_ID( hecmesh%elem_node_item (is+j))
102  endif
103  enddo
104  !C** section ID
105  isect= hecmesh%section_ID(icel)
106  !C** material ID
107  mid= hecmesh%section%sect_mat_ID_item(isect)
108  write(ilog,*) '### Element ID=',hecmesh%global_elem_ID(icel)
109  write(ilog,*) ic_type,isect,mid
110  write(ilog,*) (nids(j),j=1,nn)
111  enddo
112  enddo
113  call hecmw2fstr_mesh_conv(hecmesh)
114  !C +-------------------------------+
115  !C | Material |
116  !C +-------------------------------+
117 
118  write(ilog,*)
119  write(ilog,*) '### Material'
120 
121  ic = 0
122  do im = 1, hecmesh%material%n_mat
123  write(ilog,*)
124  write(ilog,*) ' Material No. =', im
125  do jm = 1, 3
126  ic = ic + 1
127  js= hecmesh%material%mat_TABLE_index(ic-1) + 1
128  je= hecmesh%material%mat_TABLE_index(ic )
129  nn= je - js + 1
130  if (jm.eq.1) write(ilog,*) ' Density Temperature functionA functionB'
131  if (jm.eq.2) write(ilog,*) ' Specific heat Temperature functionA functionB'
132  if (jm.eq.3) write(ilog,*) ' Conductivity Temperature functionA functionB'
133  kc = 0
134  do km = js, je
135  kc = kc + 1
136  val = hecmesh%material%mat_VAL (km)
137  temp = hecmesh%material%mat_TEMP(km)
138  if (jm.eq.1) aa = fstrheat%RHOfuncA(im,kc)
139  if (jm.eq.1) bb = fstrheat%RHOfuncB(im,kc)
140  if (jm.eq.2) aa = fstrheat%CPfuncA(im,kc)
141  if (jm.eq.2) bb = fstrheat%CPfuncB(im,kc)
142  if (jm.eq.3) aa = fstrheat%CONDfuncA(im,kc)
143  if (jm.eq.3) bb = fstrheat%CONDfuncB(im,kc)
144  write(ilog,'(1p4e13.4)') val,temp,aa,bb
145  enddo
146  if (jm.eq.1) aa = fstrheat%RHOfuncA(im,kc+1)
147  if (jm.eq.1) bb = fstrheat%RHOfuncB(im,kc+1)
148  if (jm.eq.2) aa = fstrheat%CPfuncA(im,kc+1)
149  if (jm.eq.2) bb = fstrheat%CPfuncB(im,kc+1)
150  if (jm.eq.3) aa = fstrheat%CONDfuncA(im,kc+1)
151  if (jm.eq.3) bb = fstrheat%CONDfuncB(im,kc+1)
152  write(ilog,'(26x,1p2e13.4)') aa,bb
153  enddo
154  enddo
155 
156  !C +-------------------------------+
157  !C | NODE GROUP |
158  !C +-------------------------------+
159 
160  write(ilog,*)
161  write(ilog,*) '### Ngroup'
162 
163  do ig1= 1, hecmesh%node_group%n_grp
164  write(ilog,*)
165  write(ilog,'(a80)') hecmesh%node_group%grp_name(ig1)
166  is0= hecmesh%node_group%grp_index(ig1-1) + 1
167  ie0= hecmesh%node_group%grp_index(ig1 )
168  do ik= is0, ie0
169  in = hecmesh%node_group%grp_item(ik)
170  write(ilog,*) in
171  enddo
172  enddo
173 
174  !C +-------------------------------+
175  !C | ELEMENT GROUP |
176  !C +-------------------------------+
177 
178  write(ilog,*)
179  write(ilog,*) '### Egroup'
180 
181  do ig1= 1, hecmesh%elem_group%n_grp
182  write(ilog,*)
183  write(ilog,'(a80)') hecmesh%elem_group%grp_name(ig1)
184  is0= hecmesh%elem_group%grp_index(ig1-1) + 1
185  ie0= hecmesh%elem_group%grp_index(ig1 )
186  do ik= is0, ie0
187  in = hecmesh%elem_group%grp_item(ik)
188  write(ilog,*) in
189  enddo
190  enddo
191 
192  !C +-------------------------------+
193  !C | BOUNDARY |
194  !C +-------------------------------+
195 
196  write(ilog,*)
197  write(ilog,*) '### Boundary'
198 
199  write(ilog,*) ' T_FIX_tot :', fstrheat%T_FIX_tot
200  write(ilog,*) ' No./ NID/ amp/ TEMP-BOUNDARY '
201  do i = 1, fstrheat%T_FIX_tot
202  inod = hecmesh%global_node_ID( fstrheat%T_FIX_node(i) )
203  write(ilog,'(2i10,i5,1PE15.7)') i, inod, fstrheat%T_FIX_ampl(i) &
204  , fstrheat%T_FIX_val (i)
205  enddo
206 
207  write(ilog,*) ' Q_NOD_tot :', fstrheat%Q_NOD_tot
208  write(ilog,*) ' No./ NID/ amp/ Q-POINT '
209  do i = 1, fstrheat%Q_NOD_tot
210  in = hecmesh%global_node_ID( fstrheat%Q_NOD_node(i) )
211  write(ilog,'(2i10,i5,1PE15.7)') i, inod, fstrheat%Q_NOD_ampl(i) &
212  , fstrheat%Q_NOD_val (i)
213  enddo
214 
215  write(ilog,*) ' Q_VOL_tot :', fstrheat%Q_VOL_tot
216  write(ilog,*) ' No./ EID/ SID/ amp/ Q-VOL '
217  do i = 1, fstrheat%Q_VOL_tot
218  ie = hecmesh%global_elem_ID( fstrheat%Q_VOL_elem(i) )
219  write(ilog,'(2i10,i5,1PE15.7)') i, ie, fstrheat%Q_VOL_ampl(i) &
220  , fstrheat%Q_VOL_val (i)
221  enddo
222 
223  write(ilog,*) ' Q_SUF_tot :', fstrheat%Q_SUF_tot
224  write(ilog,*) ' No./ EID/ SID/ amp/ Q-SURF '
225  do i = 1, fstrheat%Q_SUF_tot
226  ie = hecmesh%global_elem_ID( fstrheat%Q_SUF_elem(i) )
227  write(ilog,'(2i10,2i5,1PE15.7)') i, ie, fstrheat%Q_SUF_surf(i) &
228  , fstrheat%Q_SUF_ampl(i), fstrheat%Q_SUF_val (i)
229 
230  enddo
231 
232  write(ilog,*) ' H_SUF_tot :', fstrheat%H_SUF_tot
233  write(ilog,*) ' No./ EID/ SID/ H_amp/ T_amp/ HH/ Sink/ '
234  do i = 1, fstrheat%H_SUF_tot
235  ie = hecmesh%global_elem_ID( fstrheat%H_SUF_elem(i) )
236  write(ilog,'(2i10,3i5,1P2E15.7)') i, ie, fstrheat%H_SUF_surf(i) &
237  , fstrheat%H_SUF_ampl(i,1), fstrheat%H_SUF_ampl(i,2) &
238  , fstrheat%H_SUF_val (i,1), fstrheat%H_SUF_val (i,2)
239  enddo
240 
241  write(ilog,*) ' R_SUF_tot :', fstrheat%R_SUF_tot
242  write(ilog,*) ' No./ EID/ SID/ R_amp/ T_amp/ RR/ Sink/ '
243  do i = 1, fstrheat%R_SUF_tot
244  ie = hecmesh%global_elem_ID( fstrheat%R_SUF_elem(i) )
245  write(ilog,'(2i10,3i5,1P2E15.7)') i, ie, fstrheat%R_SUF_surf(i) &
246  , fstrheat%R_SUF_ampl(i,1), fstrheat%R_SUF_ampl(i,2) &
247  , fstrheat%R_SUF_val (i,1), fstrheat%R_SUF_val (i,2)
248  enddo
249 
250  !C +-------------------------------+
251  !C | Amplitude |
252  !C +-------------------------------+
253 
254  write(ilog,*)
255  write(ilog,*) '### Amplitude'
256 
257  write(ilog,*) ' AMPLITUDEtot :', fstrheat%AMPLITUDEtot
258  do i = 1, fstrheat%AMPLITUDEtot
259  nn = fstrheat%AMPLtab(i)
260  write(ilog,'(2i5,a,a10)') i, nn,' : name=', hecmesh%amp%amp_name(i)
261 
262  do j = 1, nn
263  time = fstrheat%AMPLtime(i,j)
264  val = fstrheat%AMPL (i,j)
265  aa = fstrheat%AMPLfuncA(i,j)
266  bb = fstrheat%AMPLfuncB(i,j)
267  write(ilog,'(i5,1p4e12.4)') j,time,val,aa,bb
268  enddo
269  aa = fstrheat%AMPLfuncA(i,nn+1)
270  bb = fstrheat%AMPLfuncB(i,nn+1)
271  write(ilog,'(i5,1p4e12.4)') nn+1,time,val,aa,bb
272 
273  enddo
274 
275  end subroutine heat_echo
276 end module m_heat_echo
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.F90:15
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.F90:118
m_heat_echo
ECHO for HEAT solver.
Definition: heat_echo.f90:6
m_heat_echo::heat_echo
subroutine heat_echo(p, hecMESH, fstrHEAT)
Definition: heat_echo.f90:10
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_hecmw2fstr_mesh_conv::fstr2hecmw_mesh_conv
subroutine fstr2hecmw_mesh_conv(hecMESH)
Definition: hecmw2fstr_mesh_conv.f90:27
m_hecmw2fstr_mesh_conv::hecmw2fstr_mesh_conv
subroutine hecmw2fstr_mesh_conv(hecMESH)
Definition: hecmw2fstr_mesh_conv.f90:15
m_fstr::fstr_heat
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.F90:440
m_fstr::fstr_param
FSTR INNER CONTROL PARAMETERS (fstrPARAM)
Definition: m_fstr.F90:142