FrontISTR  5.9.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  end subroutine heat_init
46 
47  subroutine heat_init_log(hecMESH, fstrHEAT)
48  use m_fstr
49  implicit none
50  type(hecmwst_local_mesh) :: hecMESH
51  type(fstr_heat) :: fstrHEAT
52  integer(kind=kint) :: nradiate
53 
54  if(hecmesh%my_rank == 0)then
55  write(imsg,*) '============================='
56  write(imsg,*) ' H E A T T R A N S F E R '
57  write(imsg,*) '============================='
58  write(ista,*)
59  write(ista,*)' ISTEP INCR ITER RESIDUAL IITER '
60  write(ista,*)'-------------------------------------------------'
61  endif
62 
63  nradiate = fstrheat%R_SUF_tot
64  call hecmw_allreduce_i1(hecmesh, nradiate, hecmw_sum)
65  if(nradiate > 0 .and. hecmesh%my_rank == 0)then
66  write(imsg,"(a,f12.4)")"* Absolute zero temperature for radiation: ", hecmesh%zero_temp
67  endif
68  end subroutine heat_init_log
69 
70  subroutine heat_finalize(fstrHEAT)
71  use m_fstr
72  implicit none
73  type(fstr_heat) :: fstrHEAT
74  deallocate(fstrheat%TEMP0)
75  deallocate(fstrheat%TEMPC)
76  deallocate(fstrheat%TEMP )
77  end subroutine heat_finalize
78 
79  !C***
80  !C*** INIT_AMPLITUDE
81  !C***
82  subroutine heat_init_amplitude (hecMESH, fstrHEAT)
83 
84  use m_fstr
85 
86  implicit none
87  integer(kind=kint) :: namax, i, nn, is, iE, icou, j, k
88  real(kind=kreal) :: x1, y1, x2, y2
89  type(fstr_heat) :: fstrheat
90  type(hecmwst_local_mesh) :: hecMESH
91  !C
92  !C===
93  namax = 0
94  do i = 1, hecmesh%amp%n_amp
95  nn = hecmesh%amp%amp_index(i) - hecmesh%amp%amp_index(i-1)
96  namax = max(nn,namax)
97  enddo
98 
99  fstrheat%AMPLITUDEtot= hecmesh%amp%n_amp
100 
101  allocate (fstrheat%AMPLtab (fstrheat%AMPLITUDEtot) )
102  allocate (fstrheat%AMPL (fstrheat%AMPLITUDEtot,namax), &
103  fstrheat%AMPLtime(fstrheat%AMPLITUDEtot,namax) )
104 
105  fstrheat%AMPLtab = 0
106  fstrheat%AMPL = 0.d0
107  fstrheat%AMPLtime = 0.d0
108 
109  do i = 1, fstrheat%AMPLITUDEtot
110  is = hecmesh%amp%amp_index(i-1) + 1
111  ie = hecmesh%amp%amp_index(i)
112  nn = ie - is + 1
113 
114  fstrheat%AMPLtab(i) = nn
115 
116  icou = 0
117  do j = is, ie
118  icou = icou + 1
119  fstrheat%AMPL (i,icou) = hecmesh%amp%amp_val (j)
120  fstrheat%AMPLtime(i,icou) = hecmesh%amp%amp_table(j)
121  enddo
122  enddo
123  !C===
124 
125  !C
126  !C +-----------+
127  !C | AMP-TABLE |
128  !C +-----------+
129  !C===
130  allocate ( fstrheat%AMPLfuncA( fstrheat%AMPLITUDEtot,namax+1 ) )
131  allocate ( fstrheat%AMPLfuncB( fstrheat%AMPLITUDEtot,namax+1 ) )
132 
133  fstrheat%AMPLfuncA = 0.d0
134  fstrheat%AMPLfuncB = 0.d0
135  !C
136  !C--
137  do i = 1, fstrheat%AMPLITUDEtot
138 
139  fstrheat%AMPLfuncA(i,1) = 0.d0
140  fstrheat%AMPLfuncB(i,1) = fstrheat%AMPL(i,1)
141 
142  nn = fstrheat%AMPLtab(i)
143 
144  do k = 2, nn
145 
146  x1 = fstrheat%AMPLtime(i,k-1)
147  y1 = fstrheat%AMPL (i,k-1)
148  x2 = fstrheat%AMPLtime(i,k)
149  y2 = fstrheat%AMPL (i,k)
150 
151  fstrheat%AMPLfuncA(i,k) = (y2-y1)/(x2-x1)
152  fstrheat%AMPLfuncB(i,k) = -(y2-y1)/(x2-x1)*x1 + y1
153 
154  enddo
155 
156  fstrheat%AMPLfuncA(i,nn+1) = 0.d0
157  fstrheat%AMPLfuncB(i,nn+1) = fstrheat%AMPL(i,nn)
158 
159  enddo
160 
161  !C===
162  end subroutine heat_init_amplitude
163  !C***
164  !C*** INIT_MATERIAL
165  !C***
166  subroutine heat_init_material (hecMESH, fstrHEAT)
167 
168  use m_fstr
169 
170  implicit none
171  integer(kind=kint) :: m1max, m2max, m3max, icou, im, jm, nn, ic, jS, jE, kc, km, k
172  real(kind=kreal) :: aa, bb
173  type(fstr_heat) :: fstrheat
174  type(hecmwst_local_mesh) :: hecMESH
175 
176  !C
177  !C +----------+
178  !C | MATERIAL |
179  !C +----------+
180  !C===
181  fstrheat%MATERIALtot= hecmesh%material%n_mat
182 
183  m1max = 0
184  m2max = 0
185  m3max = 0
186  icou = 0
187  do im = 1, hecmesh%material%n_mat
188  do jm = 1, 3
189  icou = icou + 1
190  nn = hecmesh%material%mat_TABLE_index(icou) - hecmesh%material%mat_TABLE_index(icou-1)
191  if( jm.eq.1 ) m1max = max(nn,m1max)
192  if( jm.eq.2 ) m2max = max(nn,m2max)
193  if( jm.eq.3 ) m3max = max(nn,m3max)
194  enddo
195  enddo
196 
197  allocate (fstrheat%RHOtab (fstrheat%MATERIALtot), &
198  fstrheat%CPtab (fstrheat%MATERIALtot), &
199  fstrheat%CONDtab (fstrheat%MATERIALtot))
200  allocate (fstrheat%RHO (fstrheat%MATERIALtot,m1max), &
201  fstrheat%RHOtemp (fstrheat%MATERIALtot,m1max))
202  allocate (fstrheat%CP (fstrheat%MATERIALtot,m2max), &
203  fstrheat%CPtemp (fstrheat%MATERIALtot,m2max))
204  allocate (fstrheat%COND (fstrheat%MATERIALtot,m3max), &
205  fstrheat%CONDtemp(fstrheat%MATERIALtot,m3max))
206 
207  fstrheat%RHO = 0.d0
208  fstrheat%CP = 0.d0
209  fstrheat%COND = 0.d0
210 
211  fstrheat%RHOtemp = 0.d0
212  fstrheat%CPtemp = 0.d0
213  fstrheat%CONDtemp = 0.d0
214  fstrheat%RHOtab = 0
215  fstrheat%CPtab = 0
216  fstrheat%CONDtab = 0
217 
218  ic = 0
219  do im = 1, fstrheat%MATERIALtot
220  do jm = 1, 3
221  ic = ic + 1
222  js = hecmesh%material%mat_TABLE_index(ic-1) + 1
223  je = hecmesh%material%mat_TABLE_index(ic )
224  nn = je - js + 1
225  if( jm.eq.1 ) fstrheat%RHOtab (im) = nn
226  if( jm.eq.2 ) fstrheat%CPtab (im) = nn
227  if( jm.eq.3 ) fstrheat%CONDtab(im) = nn
228 
229  kc = 0
230  do km = js, je
231  kc = kc + 1
232  if( jm.eq.1 ) then
233  fstrheat%RHO (im,kc) = hecmesh%material%mat_VAL (km)
234  fstrheat%RHOtemp (im,kc) = hecmesh%material%mat_TEMP(km)
235  endif
236  if( jm.eq.2 ) then
237  fstrheat%CP (im,kc) = hecmesh%material%mat_VAL (km)
238  fstrheat%CPtemp (im,kc) = hecmesh%material%mat_TEMP(km)
239  endif
240  if( jm.eq.3 ) then
241  fstrheat%COND (im,kc) = hecmesh%material%mat_VAL (km)
242  fstrheat%CONDtemp(im,kc) = hecmesh%material%mat_TEMP(km)
243  endif
244  enddo
245  enddo
246  enddo
247  !C===
248 
249  !C
250  !C +-----------+
251  !C | MAT-TABLE |
252  !C +-----------+
253  !C===
254  allocate (fstrheat%RHOfuncA (fstrheat%MATERIALtot, m1max+1) &
255  ,fstrheat%RHOfuncB (fstrheat%MATERIALtot, m1max+1))
256  allocate (fstrheat%CPfuncA (fstrheat%MATERIALtot, m2max+1) &
257  ,fstrheat%CPfuncB (fstrheat%MATERIALtot, m2max+1))
258  allocate (fstrheat%CONDfuncA(fstrheat%MATERIALtot, m3max+1) &
259  ,fstrheat%CONDfuncB(fstrheat%MATERIALtot, m3max+1))
260 
261  fstrheat%RHOfuncA = 0.d0
262  fstrheat%RHOfuncB = 0.d0
263  fstrheat%CPfuncA = 0.d0
264  fstrheat%CPfuncB = 0.d0
265  fstrheat%CONDfuncA = 0.d0
266  fstrheat%CONDfuncB = 0.d0
267  !C
268  !C--RHO
269  do im = 1, fstrheat%MATERIALtot
270  fstrheat%RHOfuncB(im,1) = fstrheat%RHO(im,1)
271  do k = 2, fstrheat%RHOtab(im)
272  bb= fstrheat%RHO (im,k) - fstrheat%RHO (im,k-1)
273  aa= fstrheat%RHOtemp(im,k) - fstrheat%RHOtemp(im,k-1)
274  fstrheat%RHOfuncA(im,k) = bb/aa
275  fstrheat%RHOfuncB(im,k) = -(bb/aa)*fstrheat%RHOtemp(im,k-1) + fstrheat%RHO(im,k-1)
276  enddo
277  fstrheat%RHOfuncB(im,fstrheat%RHOtab(im)+1) = fstrheat%RHO(im,fstrheat%RHOtab(im))
278  enddo
279  !C
280  !C-- CP
281  do im = 1, fstrheat%MATERIALtot
282  fstrheat%CPfuncB(im,1) = fstrheat%CP(im,1)
283  do k = 2, fstrheat%CPtab(im)
284  bb= fstrheat%CP (im,k) - fstrheat%CP (im,k-1)
285  aa= fstrheat%CPtemp(im,k) - fstrheat%CPtemp(im,k-1)
286  fstrheat%CPfuncA(im,k) = bb/aa
287  fstrheat%CPfuncB(im,k) = -(bb/aa)*fstrheat%CPtemp(im,k-1) + fstrheat%CP(im,k-1)
288  enddo
289  fstrheat%CPfuncB(im,fstrheat%CPtab(im)+1) = fstrheat%CP(im,fstrheat%CPtab(im))
290  enddo
291  !C
292  !C-- COND.
293  do im = 1, fstrheat%MATERIALtot
294  fstrheat%CONDfuncB(im,1)= fstrheat%COND(im,1)
295  do k = 2, fstrheat%CONDtab(im)
296  bb = fstrheat%COND (im,k) - fstrheat%COND (im,k-1)
297  aa = fstrheat%CONDtemp(im,k) - fstrheat%CONDtemp(im,k-1)
298  fstrheat%CONDfuncA(im,k) = bb/aa
299  fstrheat%CONDfuncB(im,k) = -(bb/aa)*fstrheat%CONDtemp(im,k-1) + fstrheat%COND(im,k-1)
300  enddo
301  fstrheat%CONDfuncB(im,fstrheat%CONDtab(im)+1) = fstrheat%COND(im,fstrheat%CONDtab(im))
302  enddo
303  !C===
304  end subroutine heat_init_material
305 
306 end module m_heat_init
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:117
m_fstr::ilog
integer(kind=kint), parameter ilog
FILE HANDLER.
Definition: m_fstr.F90:114
m_fstr::ista
integer(kind=kint), parameter ista
Definition: m_fstr.F90:115
m_fstr::g_initialcnd
type(tinitialcondition), dimension(:), pointer, save g_initialcnd
Definition: m_fstr.F90:158
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:71
m_heat_init::heat_init_log
subroutine heat_init_log(hecMESH, fstrHEAT)
Definition: heat_init.f90:48
m_heat_init::heat_init_material
subroutine heat_init_material(hecMESH, fstrHEAT)
Definition: heat_init.f90:167
m_heat_init::heat_init
subroutine heat_init(hecMESH, fstrHEAT)
Definition: heat_init.f90:10
m_heat_init::heat_init_amplitude
subroutine heat_init_amplitude(hecMESH, fstrHEAT)
Definition: heat_init.f90:83
m_fstr::fstr_heat
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.F90:458