FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
heat_mat_ass_bc_DFLUX.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!-------------------------------------------------------------------------------
8 use m_fstr
9
10 implicit none
11contains
12 !C
13 !C***
14 !C*** MAT_ASS_DFLUX
15 !C***
16 !C
17 subroutine heat_mat_ass_bc_dflux( hecMESH, hecMAT, fstrHEAT, CTIME, DTIME, beta )
21 integer(kind=kint) :: k, icel, ic_type, isect, isuf, iamp, nn, is, j
22 real(kind=kreal) :: ctime, dtime, qq, val, asect, thick, vol, beta
23 type(fstr_heat) :: fstrheat
24 type(hecmwst_matrix) :: hecMAT
25 type(hecmwst_local_mesh) :: hecMESH
26 real(kind=kreal) :: xx(20), yy(20), zz(20)
27 real(kind=kreal) :: vect(20), ss(2000)
28 integer(kind=kint) :: ig0, ig, iS0, iE0, nodLocal(20)
29 real(kind=kreal), allocatable :: bbak(:)
30
31 !C
32 !$omp parallel default(none), &
33 !$omp& private(k,icel,ic_type,isect,isuf,iamp,QQ,val,nn,is,j,nodLOCAL,xx,yy,zz,asect,vect,thick), &
34 !$omp& shared(fstrHEAT,CTIME,hecMAT,hecMESH)
35 !$omp do
36 do k = 1, fstrheat%Q_SUF_tot
37
38 icel = fstrheat%Q_SUF_elem(k)
39 ic_type = hecmesh%elem_type(icel)
40 isect = hecmesh%section_ID(icel)
41 isuf = fstrheat%Q_SUF_surf(k)
42 iamp = fstrheat%Q_SUF_ampl(k)
43
44 call heat_get_amplitude( fstrheat,iamp,ctime,qq )
45 val = fstrheat%Q_SUF_val (k) * qq
46 if( dabs(val) < 1.d-16 ) cycle
47 !C**
48 nn = hecmw_get_max_node(ic_type)
49 !C**
50 is = hecmesh%elem_node_index(icel-1)
51 do j = 1, nn
52 nodlocal(j) = hecmesh%elem_node_item(is+j)
53 xx(j) = hecmesh%node( 3*nodlocal(j)-2 )
54 yy(j) = hecmesh%node( 3*nodlocal(j)-1 )
55 zz(j) = hecmesh%node( 3*nodlocal(j) )
56 enddo
57 !C**
58 if ( ic_type.eq.111 ) then
59 is = hecmesh%section%sect_R_index(isect)
60 asect = hecmesh%section%sect_R_item(is)
61 call heat_dflux_111(nn,xx,yy,zz,asect,isuf,val,vect)
62
63 elseif( ic_type.eq.231 ) then
64 is = hecmesh%section%sect_R_index(isect)
65 thick = hecmesh%section%sect_R_item(is)
66 call heat_dflux_231(nn,xx,yy,zz,thick,isuf,val,vect)
67
68 elseif( ic_type.eq.232 ) then
69 is = hecmesh%section%sect_R_index(isect)
70 thick = hecmesh%section%sect_R_item(is)
71 call heat_dflux_232(nn,xx,yy,zz,thick,isuf,val,vect)
72
73 elseif( ic_type.eq.241 ) then
74 is = hecmesh%section%sect_R_index(isect)
75 thick = hecmesh%section%sect_R_item(is)
76 call heat_dflux_241(nn,xx,yy,zz,thick,isuf,val,vect)
77
78 elseif( ic_type.eq.242 ) then
79 is = hecmesh%section%sect_R_index(isect)
80 thick = hecmesh%section%sect_R_item(is)
81 call heat_dflux_242(nn,xx,yy,zz,thick,isuf,val,vect)
82
83 elseif( ic_type.eq.341 ) then
84 call heat_dflux_341(nn,xx,yy,zz,isuf,val,vect)
85
86 elseif( ic_type.eq.342 ) then
87 call heat_dflux_342(nn,xx,yy,zz,isuf,val,vect)
88
89 elseif( ic_type.eq.351 ) then
90 call heat_dflux_351(nn,xx,yy,zz,isuf,val,vect)
91
92 elseif( ic_type.eq.352 ) then
93 call heat_dflux_352(nn,xx,yy,zz,isuf,val,vect)
94
95 elseif( ic_type.eq.361 ) then
96 call heat_dflux_361(nn,xx,yy,zz,isuf,val,vect)
97
98 elseif( ic_type.eq.362 ) then
99 call heat_dflux_362(nn,xx,yy,zz,isuf,val,vect)
100
101 elseif( ic_type.eq.731 ) then
102 is = hecmesh%section%sect_R_index(isect)
103 thick = hecmesh%section%sect_R_item(is)
104 call heat_dflux_731(nn,xx,yy,zz,thick,isuf,val,vect)
105
106 elseif( ic_type.eq.741 ) then
107 is = hecmesh%section%sect_R_index(isect)
108 thick = hecmesh%section%sect_R_item(is)
109 call heat_dflux_741(nn,xx,yy,zz,thick,isuf,val,vect)
110
111 endif
112
113 do j = 1, nn
114 !$omp atomic
115 hecmat%B( nodlocal(j) ) = hecmat%B( nodlocal(j) ) - vect(j)
116 enddo
117 enddo
118 !$omp end do
119 !$omp end parallel
120
121 if( fstrheat%WL_tot>0 ) then
122 allocate( bbak(size(hecmat%B)) )
123
124 do ig0 = 1, fstrheat%WL_tot
125 ig = fstrheat%weldline(ig0)%egrpid
126 is0= hecmesh%elem_group%grp_index(ig-1) + 1
127 ie0= hecmesh%elem_group%grp_index(ig )
128 vol =0.d0; bbak=0.d0
129 do k=is0, ie0
130 icel = hecmesh%elem_group%grp_item(k)
131 ic_type = hecmesh%elem_type(icel)
132 isect = hecmesh%section_ID(icel)
133 isuf = 0
134
135 nn = hecmw_get_max_node(ic_type)
136 is = hecmesh%elem_node_index(icel-1)
137 do j = 1, nn
138 nodlocal(j) = hecmesh%elem_node_item(is+j)
139 xx(j) = hecmesh%node( 3*nodlocal(j)-2 )
140 yy(j) = hecmesh%node( 3*nodlocal(j)-1 )
141 zz(j) = hecmesh%node( 3*nodlocal(j) )
142 enddo
143
144 if( .not. isweldactive(nn, xx,yy,zz, fstrheat%weldline(ig0), ctime-0.5d0*dtime) ) cycle
145
146 vol = vol + volume_c3(ic_type,nn,xx,yy,zz)
147 val = fstrheat%weldline(ig0)%I * fstrheat%weldline(ig0)%U * &
148 fstrheat%weldline(ig0)%coe
149 write(idbg,*) "Element", hecmesh%global_elem_id(icel),"with dflux", val, vol
150
151 if( ic_type.eq.341 ) then
152 call heat_dflux_341(nn,xx,yy,zz,isuf,val,vect)
153
154 elseif( ic_type.eq.342 ) then
155 call heat_dflux_342(nn,xx,yy,zz,isuf,val,vect)
156
157 elseif( ic_type.eq.351 ) then
158 call heat_dflux_351(nn,xx,yy,zz,isuf,val,vect)
159
160 elseif( ic_type.eq.352 ) then
161 call heat_dflux_352(nn,xx,yy,zz,isuf,val,vect)
162
163 elseif( ic_type.eq.361 ) then
164 call heat_dflux_361(nn,xx,yy,zz,isuf,val,vect)
165
166 elseif( ic_type.eq.362 ) then
167 call heat_dflux_362(nn,xx,yy,zz,isuf,val,vect)
168
169
170 else
171 write(*,*) '###ERROR### : Element type not supported for heat analysis'
172 write(*,*) ' ic_type = ', ic_type
173 call hecmw_abort(hecmw_comm_get_comm())
174
175 endif
176
177 do j = 1, nn
178 bbak( nodlocal(j) ) = bbak( nodlocal(j) ) - vect(j)
179 enddo
180 enddo
181
182 if( vol>0 ) then
183 bbak = bbak/vol
184 hecmat%B = hecmat%B + bbak
185 endif
186 enddo
187
188 deallocate(bbak)
189 endif
190
191 end subroutine heat_mat_ass_bc_dflux
192
193 logical function isweldactive(nn, xx,yy,zz, weldline, ctime)
194 integer, intent(in) :: nn
195 real(kind=kreal), intent(in) :: xx(:), yy(:), zz(:)
196 type(tweldline), intent(in) :: weldline
197 real(kind=kreal), intent(in) :: ctime
198
199 integer :: i
200 real(kind=kreal) :: cpos, wpos, tend
201
202 isweldactive = .false.
203 tend = weldline%tstart+ (weldline%n2-weldline%n1)/weldline%v
204 if( ctime<weldline%tstart .or. ctime>tend ) return
205 cpos = 0
206 do i=1,nn
207 if( weldline%xyz==1 ) then
208 cpos = cpos+xx(i)
209 elseif( weldline%xyz==2 ) then
210 cpos = cpos+yy(i)
211 else
212 cpos = cpos+zz(i)
213 endif
214 enddo
215 cpos = cpos/nn
216 wpos = weldline%n1 + weldline%v*(ctime-weldline%tstart)
217 if( dabs(cpos-wpos)<weldline%distol ) isweldactive = .true.
218 end function
This module defined coomon data and basic structures for analysis.
Definition: m_fstr.f90:15
integer(kind=kint), parameter idbg
Definition: m_fstr.f90:95
This moudle provide a function to get amplitude definition.
subroutine heat_get_amplitude(fstrheat, id, tt, qq, outofrange)
This module provides subroutines for calculating distributed heat flux for various elements.
subroutine heat_dflux_232(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_341(nn, xx, yy, zz, ltype, val, vect)
subroutine heat_dflux_362(nn, xx, yy, zz, ltype, val, vect)
subroutine heat_dflux_352(nn, xx, yy, zz, ltype, val, vect)
subroutine heat_dflux_231(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_342(nn, xx, yy, zz, ltype, val, vect)
subroutine heat_dflux_351(nn, xx, yy, zz, ltype, val, vect)
subroutine heat_dflux_241(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_731(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_242(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_111(nn, xx, yy, zz, asect, ltype, val, vect)
subroutine heat_dflux_741(nn, xx, yy, zz, thick, ltype, val, vect)
subroutine heat_dflux_361(nn, xx, yy, zz, ltype, val, vect)
This module provides a subroutine for setting distributed heat flux boundary conditions.
subroutine heat_mat_ass_bc_dflux(hecmesh, hecmat, fstrheat, ctime, dtime, beta)
logical function isweldactive(nn, xx, yy, zz, weldline, ctime)
This module provide common functions of Solid elements.
real(kind=kreal) function volume_c3(etype, nn, xx, yy, zz)
Volume of element.
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.f90:394
Data for weld line.
Definition: m_fstr.f90:597