FrontISTR  6.0.0
Large-scale structural analysis program with finit element method
heat_init.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_init
7 contains
8 
9  subroutine heat_init(hecMESH, fstrHEAT)
10  use m_fstr
11  implicit none
12  type(fstr_heat) :: fstrHEAT
13  type(hecmwst_local_mesh) :: hecMESH
14  integer(kind=kint) :: i, j
15 
16  allocate(fstrheat%TEMP0(hecmesh%n_node))
17  allocate(fstrheat%TEMPC(hecmesh%n_node))
18  allocate(fstrheat%TEMP (hecmesh%n_node))
19  fstrheat%TEMP0 = 0.0d0
20  fstrheat%TEMPC = 0.0d0
21  fstrheat%TEMP = 0.0d0
22 
23  if(hecmesh%hecmw_flag_initcon == 1)then
24  do i = 1, hecmesh%n_node
25  j = hecmesh%node_init_val_index(i)
26  fstrheat%TEMP0(i) = hecmesh%node_init_val_item(j)
27  fstrheat%TEMPC(i) = fstrheat%TEMP0(i)
28  fstrheat%TEMP (i) = fstrheat%TEMP0(i)
29  enddo
30  write(ilog,*) ' Initial condition of temperatures: OK'
31  endif
32  if( associated(g_initialcnd) ) then
33  do j=1,size(g_initialcnd)
34  if( g_initialcnd(j)%cond_name=="temperature" ) then
35  do i= 1, hecmesh%n_node
36  fstrheat%TEMP0(i)= g_initialcnd(j)%realval(i)
37  fstrheat%TEMPC(i)= fstrheat%TEMP0(i)
38  fstrheat%TEMP (i)= fstrheat%TEMP0(i)
39  enddo
40  exit
41  endif
42  enddo
43  write(ilog,*) ' Initial condition of temperatures: OK'
44  endif
45 
46  call heat_fix_dummy_nodes(hecmesh, fstrheat)
47  end subroutine heat_init
48 
52  subroutine heat_fix_dummy_nodes(hecMESH, fstrHEAT)
53  use m_fstr
54  use hecmw_etype, only : hecmw_is_etype_33struct, hecmw_get_max_node
55  use hecmw_setup_util, only : hecmw_expand_integer_array, hecmw_expand_real_array
56  implicit none
57  type(fstr_heat) :: fstrHEAT
58  type(hecmwst_local_mesh) :: hecMESH
59  integer(kind=kint) :: icel, i, j, in0, nn, n_dummy, old_size, new_size
60 
61  allocate(fstrheat%is_dummy_node(hecmesh%n_node))
62  fstrheat%is_dummy_node = .false.
63 
64  do icel = 1, hecmesh%n_elem
65  if( .not. hecmw_is_etype_33struct(hecmesh%elem_type(icel)) ) cycle
66  nn = hecmw_get_max_node(hecmesh%elem_type(icel))/2
67  in0 = hecmesh%elem_node_index(icel-1)
68  do i = 1, nn
69  fstrheat%is_dummy_node(hecmesh%elem_node_item(in0+nn+i)) = .true.
70  enddo
71  enddo
72 
73  n_dummy = count(fstrheat%is_dummy_node)
74  if( n_dummy == 0 ) return
75 
76  old_size = fstrheat%T_FIX_tot
77  new_size = old_size + n_dummy
78  call hecmw_expand_integer_array( fstrheat%T_FIX_node, old_size, new_size )
79  call hecmw_expand_integer_array( fstrheat%T_FIX_ampl, old_size, new_size )
80  call hecmw_expand_real_array( fstrheat%T_FIX_val, old_size, new_size )
81  fstrheat%T_FIX_tot = new_size
82 
83  j = old_size
84  do i = 1, hecmesh%n_node
85  if( .not. fstrheat%is_dummy_node(i) ) cycle
86  fstrheat%TEMP0(i) = 0.0d0
87  fstrheat%TEMPC(i) = 0.0d0
88  fstrheat%TEMP (i) = 0.0d0
89  j = j + 1
90  fstrheat%T_FIX_node(j) = i
91  fstrheat%T_FIX_ampl(j) = 0
92  fstrheat%T_FIX_val(j) = 0.0d0
93  enddo
94  end subroutine heat_fix_dummy_nodes
95 
96  subroutine heat_init_log(hecMESH, fstrHEAT)
97  use m_fstr
98  implicit none
99  type(hecmwst_local_mesh) :: hecMESH
100  type(fstr_heat) :: fstrHEAT
101  integer(kind=kint) :: nradiate
102 
103  if(hecmesh%my_rank == 0)then
104  write(imsg,*) '============================='
105  write(imsg,*) ' H E A T T R A N S F E R '
106  write(imsg,*) '============================='
107  write(ista,*)
108  write(ista,*)' ISTEP INCR ITER RESIDUAL IITER '
109  write(ista,*)'-------------------------------------------------'
110  endif
111 
112  nradiate = fstrheat%R_SUF_tot
113  call hecmw_allreduce_i1(hecmesh, nradiate, hecmw_sum)
114  if(nradiate > 0 .and. hecmesh%my_rank == 0)then
115  write(imsg,"(a,f12.4)")"* Absolute zero temperature for radiation: ", hecmesh%zero_temp
116  endif
117  end subroutine heat_init_log
118 
119  subroutine heat_finalize(fstrHEAT)
120  use m_fstr
121  implicit none
122  type(fstr_heat) :: fstrHEAT
123 ! deallocate(fstrHEAT%TEMP0)
124 ! deallocate(fstrHEAT%TEMPC)
125 ! deallocate(fstrHEAT%TEMP )
126 ! deallocate(fstrHEAT%is_dummy_node)
127  if(associated(fstrheat%STEP_DLTIME)) deallocate(fstrheat%STEP_DLTIME)
128  if(associated(fstrheat%STEP_EETIME)) deallocate(fstrheat%STEP_EETIME)
129  if(associated(fstrheat%STEP_DELMIN)) deallocate(fstrheat%STEP_DELMIN)
130  if(associated(fstrheat%STEP_DELMAX)) deallocate(fstrheat%STEP_DELMAX)
131  if(associated(fstrheat%RHOtab)) deallocate(fstrheat%RHOtab)
132  if(associated(fstrheat%CPtab)) deallocate(fstrheat%CPtab)
133  if(associated(fstrheat%CONDtab)) deallocate(fstrheat%CONDtab)
134  if(associated(fstrheat%RHO)) deallocate(fstrheat%RHO)
135  if(associated(fstrheat%RHOtemp)) deallocate(fstrheat%RHOtemp)
136  if(associated(fstrheat%CP)) deallocate(fstrheat%CP)
137  if(associated(fstrheat%CPtemp)) deallocate(fstrheat%CPtemp)
138  if(associated(fstrheat%COND)) deallocate(fstrheat%COND)
139  if(associated(fstrheat%CONDtemp)) deallocate(fstrheat%CONDtemp)
140  if(associated(fstrheat%RHOfuncA)) deallocate(fstrheat%RHOfuncA)
141  if(associated(fstrheat%RHOfuncB)) deallocate(fstrheat%RHOfuncB)
142  if(associated(fstrheat%CPfuncA)) deallocate(fstrheat%CPfuncA)
143  if(associated(fstrheat%CPfuncB)) deallocate(fstrheat%CPfuncB)
144  if(associated(fstrheat%CONDfuncA)) deallocate(fstrheat%CONDfuncA)
145  if(associated(fstrheat%CONDfuncB)) deallocate(fstrheat%CONDfuncB)
146  if(associated(fstrheat%AMPLtab)) deallocate(fstrheat%AMPLtab)
147  if(associated(fstrheat%AMPL)) deallocate(fstrheat%AMPL)
148  if(associated(fstrheat%AMPLtime)) deallocate(fstrheat%AMPLtime)
149  if(associated(fstrheat%AMPLfuncA)) deallocate(fstrheat%AMPLfuncA)
150  if(associated(fstrheat%AMPLfuncB)) deallocate(fstrheat%AMPLfuncB)
151  if(associated(fstrheat%TEMP0)) deallocate(fstrheat%TEMP0)
152  if(associated(fstrheat%TEMPC)) deallocate(fstrheat%TEMPC)
153  if(associated(fstrheat%TEMP)) deallocate(fstrheat%TEMP)
154  if(associated(fstrheat%is_dummy_node)) deallocate(fstrheat%is_dummy_node)
155  if(associated(fstrheat%T_FIX_node)) deallocate(fstrheat%T_FIX_node)
156  if(associated(fstrheat%T_FIX_ampl)) deallocate(fstrheat%T_FIX_ampl)
157  if(associated(fstrheat%T_FIX_val)) deallocate(fstrheat%T_FIX_val)
158  if(associated(fstrheat%Q_NOD_node)) deallocate(fstrheat%Q_NOD_node)
159  if(associated(fstrheat%Q_NOD_ampl)) deallocate(fstrheat%Q_NOD_ampl)
160  if(associated(fstrheat%Q_NOD_val)) deallocate(fstrheat%Q_NOD_val)
161  if(associated(fstrheat%Q_VOL_elem)) deallocate(fstrheat%Q_VOL_elem)
162  if(associated(fstrheat%Q_VOL_ampl)) deallocate(fstrheat%Q_VOL_ampl)
163  if(associated(fstrheat%Q_VOL_val)) deallocate(fstrheat%Q_VOL_val)
164  if(associated(fstrheat%Q_SUF_elem)) deallocate(fstrheat%Q_SUF_elem)
165  if(associated(fstrheat%Q_SUF_ampl)) deallocate(fstrheat%Q_SUF_ampl)
166  if(associated(fstrheat%Q_SUF_surf)) deallocate(fstrheat%Q_SUF_surf)
167  if(associated(fstrheat%Q_SUF_val)) deallocate(fstrheat%Q_SUF_val)
168  if(associated(fstrheat%R_SUF_elem)) deallocate(fstrheat%R_SUF_elem)
169  if(associated(fstrheat%R_SUF_ampl)) deallocate(fstrheat%R_SUF_ampl)
170  if(associated(fstrheat%R_SUF_surf)) deallocate(fstrheat%R_SUF_surf)
171  if(associated(fstrheat%R_SUF_val)) deallocate(fstrheat%R_SUF_val)
172  if(associated(fstrheat%H_SUF_elem)) deallocate(fstrheat%H_SUF_elem)
173  if(associated(fstrheat%H_SUF_ampl)) deallocate(fstrheat%H_SUF_ampl)
174  if(associated(fstrheat%H_SUF_surf)) deallocate(fstrheat%H_SUF_surf)
175  if(associated(fstrheat%H_SUF_val)) deallocate(fstrheat%H_SUF_val)
176  if(associated(fstrheat%weldline)) deallocate(fstrheat%weldline)
177  end subroutine heat_finalize
178 
179  !C***
180  !C*** INIT_AMPLITUDE
181  !C***
182  subroutine heat_init_amplitude (hecMESH, fstrHEAT)
183 
184  use m_fstr
185 
186  implicit none
187  integer(kind=kint) :: namax, i, nn, is, iE, icou, j, k
188  real(kind=kreal) :: x1, y1, x2, y2
189  type(fstr_heat) :: fstrheat
190  type(hecmwst_local_mesh) :: hecMESH
191  !C
192  !C===
193  namax = 0
194  do i = 1, hecmesh%amp%n_amp
195  nn = hecmesh%amp%amp_index(i) - hecmesh%amp%amp_index(i-1)
196  namax = max(nn,namax)
197  enddo
198 
199  fstrheat%AMPLITUDEtot= hecmesh%amp%n_amp
200 
201  allocate (fstrheat%AMPLtab (fstrheat%AMPLITUDEtot) )
202  allocate (fstrheat%AMPL (fstrheat%AMPLITUDEtot,namax), &
203  fstrheat%AMPLtime(fstrheat%AMPLITUDEtot,namax) )
204 
205  fstrheat%AMPLtab = 0
206  fstrheat%AMPL = 0.d0
207  fstrheat%AMPLtime = 0.d0
208 
209  do i = 1, fstrheat%AMPLITUDEtot
210  is = hecmesh%amp%amp_index(i-1) + 1
211  ie = hecmesh%amp%amp_index(i)
212  nn = ie - is + 1
213 
214  fstrheat%AMPLtab(i) = nn
215 
216  icou = 0
217  do j = is, ie
218  icou = icou + 1
219  fstrheat%AMPL (i,icou) = hecmesh%amp%amp_val (j)
220  fstrheat%AMPLtime(i,icou) = hecmesh%amp%amp_table(j)
221  enddo
222  enddo
223  !C===
224 
225  !C
226  !C +-----------+
227  !C | AMP-TABLE |
228  !C +-----------+
229  !C===
230  allocate ( fstrheat%AMPLfuncA( fstrheat%AMPLITUDEtot,namax+1 ) )
231  allocate ( fstrheat%AMPLfuncB( fstrheat%AMPLITUDEtot,namax+1 ) )
232 
233  fstrheat%AMPLfuncA = 0.d0
234  fstrheat%AMPLfuncB = 0.d0
235  !C
236  !C--
237  do i = 1, fstrheat%AMPLITUDEtot
238 
239  fstrheat%AMPLfuncA(i,1) = 0.d0
240  fstrheat%AMPLfuncB(i,1) = fstrheat%AMPL(i,1)
241 
242  nn = fstrheat%AMPLtab(i)
243 
244  do k = 2, nn
245 
246  x1 = fstrheat%AMPLtime(i,k-1)
247  y1 = fstrheat%AMPL (i,k-1)
248  x2 = fstrheat%AMPLtime(i,k)
249  y2 = fstrheat%AMPL (i,k)
250 
251  fstrheat%AMPLfuncA(i,k) = (y2-y1)/(x2-x1)
252  fstrheat%AMPLfuncB(i,k) = -(y2-y1)/(x2-x1)*x1 + y1
253 
254  enddo
255 
256  fstrheat%AMPLfuncA(i,nn+1) = 0.d0
257  fstrheat%AMPLfuncB(i,nn+1) = fstrheat%AMPL(i,nn)
258 
259  enddo
260 
261  !C===
262  end subroutine heat_init_amplitude
263  !C***
264  !C*** INIT_MATERIAL
265  !C***
266  subroutine heat_init_material (hecMESH, fstrHEAT)
267 
268  use m_fstr
269 
270  implicit none
271  integer(kind=kint) :: m1max, m2max, m3max, icou, im, jm, nn, ic, jS, jE, kc, km, k
272  real(kind=kreal) :: aa, bb
273  type(fstr_heat) :: fstrheat
274  type(hecmwst_local_mesh) :: hecMESH
275 
276  !C
277  !C +----------+
278  !C | MATERIAL |
279  !C +----------+
280  !C===
281  fstrheat%MATERIALtot= hecmesh%material%n_mat
282 
283  m1max = 0
284  m2max = 0
285  m3max = 0
286  icou = 0
287  do im = 1, hecmesh%material%n_mat
288  do jm = 1, 3
289  icou = icou + 1
290  nn = hecmesh%material%mat_TABLE_index(icou) - hecmesh%material%mat_TABLE_index(icou-1)
291  if( jm.eq.1 ) m1max = max(nn,m1max)
292  if( jm.eq.2 ) m2max = max(nn,m2max)
293  if( jm.eq.3 ) m3max = max(nn,m3max)
294  enddo
295  enddo
296 
297  allocate (fstrheat%RHOtab (fstrheat%MATERIALtot), &
298  fstrheat%CPtab (fstrheat%MATERIALtot), &
299  fstrheat%CONDtab (fstrheat%MATERIALtot))
300  allocate (fstrheat%RHO (fstrheat%MATERIALtot,m1max), &
301  fstrheat%RHOtemp (fstrheat%MATERIALtot,m1max))
302  allocate (fstrheat%CP (fstrheat%MATERIALtot,m2max), &
303  fstrheat%CPtemp (fstrheat%MATERIALtot,m2max))
304  allocate (fstrheat%COND (fstrheat%MATERIALtot,m3max), &
305  fstrheat%CONDtemp(fstrheat%MATERIALtot,m3max))
306 
307  fstrheat%RHO = 0.d0
308  fstrheat%CP = 0.d0
309  fstrheat%COND = 0.d0
310 
311  fstrheat%RHOtemp = 0.d0
312  fstrheat%CPtemp = 0.d0
313  fstrheat%CONDtemp = 0.d0
314  fstrheat%RHOtab = 0
315  fstrheat%CPtab = 0
316  fstrheat%CONDtab = 0
317 
318  ic = 0
319  do im = 1, fstrheat%MATERIALtot
320  do jm = 1, 3
321  ic = ic + 1
322  js = hecmesh%material%mat_TABLE_index(ic-1) + 1
323  je = hecmesh%material%mat_TABLE_index(ic )
324  nn = je - js + 1
325  if( jm.eq.1 ) fstrheat%RHOtab (im) = nn
326  if( jm.eq.2 ) fstrheat%CPtab (im) = nn
327  if( jm.eq.3 ) fstrheat%CONDtab(im) = nn
328 
329  kc = 0
330  do km = js, je
331  kc = kc + 1
332  if( jm.eq.1 ) then
333  fstrheat%RHO (im,kc) = hecmesh%material%mat_VAL (km)
334  fstrheat%RHOtemp (im,kc) = hecmesh%material%mat_TEMP(km)
335  endif
336  if( jm.eq.2 ) then
337  fstrheat%CP (im,kc) = hecmesh%material%mat_VAL (km)
338  fstrheat%CPtemp (im,kc) = hecmesh%material%mat_TEMP(km)
339  endif
340  if( jm.eq.3 ) then
341  fstrheat%COND (im,kc) = hecmesh%material%mat_VAL (km)
342  fstrheat%CONDtemp(im,kc) = hecmesh%material%mat_TEMP(km)
343  endif
344  enddo
345  enddo
346  enddo
347  !C===
348 
349  !C
350  !C +-----------+
351  !C | MAT-TABLE |
352  !C +-----------+
353  !C===
354  allocate (fstrheat%RHOfuncA (fstrheat%MATERIALtot, m1max+1) &
355  ,fstrheat%RHOfuncB (fstrheat%MATERIALtot, m1max+1))
356  allocate (fstrheat%CPfuncA (fstrheat%MATERIALtot, m2max+1) &
357  ,fstrheat%CPfuncB (fstrheat%MATERIALtot, m2max+1))
358  allocate (fstrheat%CONDfuncA(fstrheat%MATERIALtot, m3max+1) &
359  ,fstrheat%CONDfuncB(fstrheat%MATERIALtot, m3max+1))
360 
361  fstrheat%RHOfuncA = 0.d0
362  fstrheat%RHOfuncB = 0.d0
363  fstrheat%CPfuncA = 0.d0
364  fstrheat%CPfuncB = 0.d0
365  fstrheat%CONDfuncA = 0.d0
366  fstrheat%CONDfuncB = 0.d0
367  !C
368  !C--RHO
369  do im = 1, fstrheat%MATERIALtot
370  fstrheat%RHOfuncB(im,1) = fstrheat%RHO(im,1)
371  do k = 2, fstrheat%RHOtab(im)
372  bb= fstrheat%RHO (im,k) - fstrheat%RHO (im,k-1)
373  aa= fstrheat%RHOtemp(im,k) - fstrheat%RHOtemp(im,k-1)
374  fstrheat%RHOfuncA(im,k) = bb/aa
375  fstrheat%RHOfuncB(im,k) = -(bb/aa)*fstrheat%RHOtemp(im,k-1) + fstrheat%RHO(im,k-1)
376  enddo
377  fstrheat%RHOfuncB(im,fstrheat%RHOtab(im)+1) = fstrheat%RHO(im,fstrheat%RHOtab(im))
378  enddo
379  !C
380  !C-- CP
381  do im = 1, fstrheat%MATERIALtot
382  fstrheat%CPfuncB(im,1) = fstrheat%CP(im,1)
383  do k = 2, fstrheat%CPtab(im)
384  bb= fstrheat%CP (im,k) - fstrheat%CP (im,k-1)
385  aa= fstrheat%CPtemp(im,k) - fstrheat%CPtemp(im,k-1)
386  fstrheat%CPfuncA(im,k) = bb/aa
387  fstrheat%CPfuncB(im,k) = -(bb/aa)*fstrheat%CPtemp(im,k-1) + fstrheat%CP(im,k-1)
388  enddo
389  fstrheat%CPfuncB(im,fstrheat%CPtab(im)+1) = fstrheat%CP(im,fstrheat%CPtab(im))
390  enddo
391  !C
392  !C-- COND.
393  do im = 1, fstrheat%MATERIALtot
394  fstrheat%CONDfuncB(im,1)= fstrheat%COND(im,1)
395  do k = 2, fstrheat%CONDtab(im)
396  bb = fstrheat%COND (im,k) - fstrheat%COND (im,k-1)
397  aa = fstrheat%CONDtemp(im,k) - fstrheat%CONDtemp(im,k-1)
398  fstrheat%CONDfuncA(im,k) = bb/aa
399  fstrheat%CONDfuncB(im,k) = -(bb/aa)*fstrheat%CONDtemp(im,k-1) + fstrheat%COND(im,k-1)
400  enddo
401  fstrheat%CONDfuncB(im,fstrheat%CONDtab(im)+1) = fstrheat%COND(im,fstrheat%CONDtab(im))
402  enddo
403  !C===
404  end subroutine heat_init_material
405 
406 end module m_heat_init
hecmw_etype
I/O and Utility.
Definition: hecmw_etype_f.f90:7
hecmw_etype::hecmw_get_max_node
integer(kind=kint) function hecmw_get_max_node(etype)
Definition: hecmw_etype_f.f90:14
hecmw_etype::hecmw_is_etype_33struct
logical function hecmw_is_etype_33struct(etype)
Definition: hecmw_etype_f.f90:115
hecmw_setup_util
This module contains auxiliary functions in calculation setup.
Definition: hecmw_setup_util_f.f90:7
hecmw_setup_util::hecmw_expand_integer_array
subroutine hecmw_expand_integer_array(array, old_size, new_size)
Definition: hecmw_setup_util_f.f90:726
hecmw_setup_util::hecmw_expand_real_array
subroutine hecmw_expand_real_array(array, old_size, new_size)
Definition: hecmw_setup_util_f.f90:754
m_fstr
This module defines common data and basic structures for analysis.
Definition: m_fstr.F90:15
m_fstr::imsg
integer(kind=kint), parameter imsg
Definition: m_fstr.F90:121
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.F90:118
m_fstr::ista
integer(kind=kint), parameter ista
Definition: m_fstr.F90:119
m_fstr::g_initialcnd
type(tinitialcondition), dimension(:), pointer, save g_initialcnd
Definition: m_fstr.F90:139
m_heat_init
This module provides functions to initialize heat analysis.
Definition: heat_init.f90:6
m_heat_init::heat_finalize
subroutine heat_finalize(fstrHEAT)
Definition: heat_init.f90:120
m_heat_init::heat_init_log
subroutine heat_init_log(hecMESH, fstrHEAT)
Definition: heat_init.f90:97
m_heat_init::heat_init_material
subroutine heat_init_material(hecMESH, fstrHEAT)
Definition: heat_init.f90:267
m_heat_init::heat_init
subroutine heat_init(hecMESH, fstrHEAT)
Definition: heat_init.f90:10
m_heat_init::heat_fix_dummy_nodes
subroutine heat_fix_dummy_nodes(hecMESH, fstrHEAT)
Mark the rotational dummy nodes of 641/761/781 elements and fix them to zero temperature....
Definition: heat_init.f90:53
m_heat_init::heat_init_amplitude
subroutine heat_init_amplitude(hecMESH, fstrHEAT)
Definition: heat_init.f90:183
m_fstr::fstr_heat
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.F90:440