OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fixflux.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| fixflux ../engine/source/constraints/thermic/fixflux.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| finter ../engine/source/tools/curve/finter.F
30!|| s4volume ../engine/source/elements/solid/solide4/s4volume.F
31!|| s8evolume ../engine/source/elements/solid/solide8e/s8evolume.F
32!||--- uses -----------------------------------------------------
33!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
34!|| python_funct_mod ../common_source/modules/python_mod.F90
35!|| sensor_mod ../common_source/modules/sensor_mod.f90
36!||====================================================================
37 SUBROUTINE fixflux (IBFFLUX ,FBFFLUX ,NPC ,TF ,X ,IXS,
38 . NSENSOR ,SENSOR_TAB,FTHE ,IAD ,FTHESKY, PYTHON,
39 . GLOB_THERM)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE python_funct_mod
44 USE sensor_mod
45 use glob_therm_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com04_c.inc"
56#include "com08_c.inc"
57#include "parit_c.inc"
58#include "units_c.inc"
59C-----------------------------------------------,
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 type (glob_therm_) ,intent(inout) :: glob_therm
63 INTEGER ,INTENT(IN) :: NSENSOR
64 INTEGER NPC(*),IAD(4,*)
65 INTEGER IBFFLUX(GLOB_THERM%NITFLUX,*)
66 INTEGER IXS(NIXS,*)
67 my_real
68 . fbfflux(glob_therm%LFACTHER,*), tf(*), x(3,*),
69 . fthesky(lsky), fthe(*)
70 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
71 TYPE(PYTHON_) :: PYTHON
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER NL, N1, N2, N3, N4, N5, N6, N7, N8, ISENS,
76 . IFUNC_OLD,IFUNC,IAD1,IAD2,IAD3,IAD4,IFLAG
77 INTEGER IEL
78 my_real NX, NY, NZ, DYDX, TS, FLUX, TS_OLD, FCX, FCY, FLUX_DENS, AREA
79 my_real startt, stopt, fcy_old
80 my_real tta, ttb, dt1a, dt1n, volg, bid
81 my_real finter
82 EXTERNAL finter
83 INTEGER :: ISMOOTH
84C=======================================================================
85 ifunc_old = 0
86 ts_old = zero
87 fcy_old = zero
88 flux_dens = zero
89 n4 = zero
90 dt1n = zero
91C
92 IF(iparit == 0) THEN
93C-----------------------------------------------------------
94C CODE PARITH/OFF NE PAS OUBLIER LE CODE P/ON !
95C-----------------------------------------------------------
96 DO nl=1,glob_therm%NFXFLUX
97C
98 isens = ibfflux(6,nl)
99C
100 startt = fbfflux(4,nl)
101 stopt = fbfflux(5,nl)
102 tta = tt *glob_therm%THEACCFACT
103 dt1a = dt1*glob_therm%THEACCFACT
104 ttb = tta - dt1a
105 IF(isens == 0)THEN
106 ts = tta - startt
107 ELSE
108 startt = startt + sensor_tab(isens)%TSTART
109 stopt = stopt + sensor_tab(isens)%TSTART
110 ts = tta - startt
111 ENDIF
112C
113 IF(tta < startt .OR. ttb >= stopt) cycle
114 IF(tta > stopt ) THEN
115 IF(ttb <= startt) THEN
116 dt1n = stopt - startt
117 ELSE
118 dt1n = stopt - ttb
119 ENDIF
120 ELSEIF(tta <= stopt) THEN
121 IF(ttb <= startt) THEN
122 dt1n = tta - startt
123 ELSE
124 dt1n = dt1a
125 ENDIF
126 ENDIF
127C
128 ifunc = ibfflux(5,nl)
129 fcy = fbfflux(1,nl)
130 fcx = fbfflux(2,nl)
131 IF(ifunc_old /= ifunc .OR. ts_old /= ts .OR. fcy_old /= fcy ) THEN
132 ismooth = 0
133 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
134 IF(ismooth < 0) THEN
135 CALL python_call_funct1d(python, -ismooth,ts*fcx, flux_dens)
136 flux_dens = fcy*flux_dens
137 ELSE
138 flux_dens = fcy*finter(ifunc, ts*fcx,npc,tf,dydx)
139 ENDIF
140 ifunc_old = ifunc
141 ts_old = ts
142 fcy_old = fcy
143 ENDIF
144C----------------------------
145C IMPOSED SURFACIC FLUX
146C----------------------------
147 IF(ibfflux(10,nl) == 0) THEN
148 n1 = ibfflux(1,nl)
149 n2 = ibfflux(2,nl)
150 n3 = ibfflux(3,nl)
151 n4 = ibfflux(4,nl)
152C ANALYSE 3D
153 IF(n4 > 0)THEN ! QUAD
154C
155 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2))
156 + -(x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
157 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2))
158 + -(x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
159 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2))
160 + -(x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
161C
162 area = half*sqrt(nx*nx + ny*ny + nz*nz)
163 flux = area*flux_dens*dt1n
164 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
165 flux = fourth*flux
166C
167 fthe(n1) = fthe(n1) + flux
168 fthe(n2) = fthe(n2) + flux
169 fthe(n3) = fthe(n3) + flux
170 fthe(n4) = fthe(n4) + flux
171C
172 ELSEIF(n3 > 0) THEN !TRUE TRIANGLES
173 nx= (x(2,n3)-x(2,n1))*(x(3,n3)-x(3,n2))
174 + -(x(3,n3)-x(3,n1))*(x(2,n3)-x(2,n2))
175 ny= (x(3,n3)-x(3,n1))*(x(1,n3)-x(1,n2))
176 + -(x(1,n3)-x(1,n1))*(x(3,n3)-x(3,n2))
177 nz= (x(1,n3)-x(1,n1))*(x(2,n3)-x(2,n2))
178 + -(x(2,n3)-x(2,n1))*(x(1,n3)-x(1,n2))
179C
180 area = half*sqrt( nx*nx + ny*ny + nz*nz)
181 flux = area*flux_dens*dt1n
182 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
183 flux = third*flux
184C
185 fthe(n1) = fthe(n1) + flux
186 fthe(n2) = fthe(n2) + flux
187 fthe(n3) = fthe(n3) + flux
188C
189 ELSE !ANALYSE 2D
190 ny= -x(3,n2)+x(3,n1)
191 nz= x(2,n2)-x(2,n1)
192C
193 area = sqrt(ny*ny + nz*nz)
194 flux = area*flux_dens*dt1n
195 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
196 flux = half*flux
197C
198 fthe(n1) = fthe(n1) + flux
199 fthe(n2) = fthe(n2) + flux
200C
201 ENDIF
202C----------------------------
203C IMPOSED VOLUMIC FLUX
204C----------------------------
205 ELSE
206 iel = ibfflux(1,nl)
207 IF(iel == 0) THEN
208 ibfflux(1,nl)=ibfflux(8,nl)
209 iel = ibfflux(1,nl)
210 ENDIF
211 n1 = ixs(2,iel)
212 n2 = ixs(3,iel)
213 n3 = ixs(4,iel)
214 n4 = ixs(5,iel)
215 n5 = ixs(6,iel)
216 n6 = ixs(7,iel)
217 n7 = ixs(8,iel)
218 n8 = ixs(9,iel)
219
220 IF(n1 == n2 .AND. n3 == n4 .AND. n5 == n8 .AND. n6 == n7) THEN
221 CALL s4volume(x, volg, 1, n1, n3, n6, n5)
222 ELSE
223 CALL s8evolume(x, volg, bid, 1, 0, 0, 0, n1, n2, n3, n4, n5, n6, n7, n8)
224 ENDIF
225
226 flux = volg*flux_dens*dt1n
227 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
228 flux = one_over_8*flux
229C
230 fthe(n1) = fthe(n1) + flux
231 fthe(n2) = fthe(n2) + flux
232 fthe(n3) = fthe(n3) + flux
233 fthe(n4) = fthe(n4) + flux
234 fthe(n5) = fthe(n5) + flux
235 fthe(n6) = fthe(n6) + flux
236 fthe(n7) = fthe(n7) + flux
237 fthe(n8) = fthe(n8) + flux
238 ENDIF
239 ENDDO ! N=1,NFXFLUX
240C
241
242 ELSE
243C-------------------------
244C CODE PARITH/ON
245C CODE NON VECTORIEL
246C-------------------------
247 DO nl=1,glob_therm%NFXFLUX
248 isens = ibfflux(6,nl)
249 startt = fbfflux(4,nl)
250 stopt = fbfflux(5,nl)
251 tta = tt *glob_therm%THEACCFACT
252 dt1a = dt1*glob_therm%THEACCFACT
253 IF (isens == 0)THEN
254 ts = tta - startt
255 ELSE
256 startt = startt + sensor_tab(isens)%TSTART
257 stopt = stopt + sensor_tab(isens)%TSTART
258 ts = tta - startt
259 ENDIF
260 iflag = 1
261 IF(tta < startt) iflag = 0
262 IF(tta > stopt ) iflag = 0
263
264 IF(ibfflux(10,nl) == 0) THEN
265C----------------------------
266C IMPOSED SURFACIC FLUX
267C----------------------------
268 IF(iflag==1) THEN
269 n1 =ibfflux(1,nl)
270 n2 =ibfflux(2,nl)
271 n3 =ibfflux(3,nl)
272 n4 =ibfflux(4,nl)
273 ifunc = ibfflux(5,nl)
274 fcy = fbfflux(1,nl)
275 fcx = fbfflux(2,nl)
276 IF(ifunc_old /= ifunc .OR. ts_old /= ts) THEN
277 ismooth = 0
278 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
279 IF(ismooth < 0) THEN
280 CALL python_call_funct1d(python, -ismooth,ts*fcx, flux_dens)
281 ELSE
282 flux_dens = finter(ifunc,ts*fcx,npc,tf,dydx)
283 ENDIF
284 ifunc_old = ifunc
285 ts_old = ts
286 ENDIF
287C
288C ANALYSE 3D
289 IF(n4 > 0)THEN
290 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2))
291 + -(x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
292 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2))
293 + -(x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
294 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2))
295 + -(x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
296C
297 area = half*sqrt(nx*nx + ny*ny + nz*nz)
298 flux = area*flux_dens*fcy*dt1a
299 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
300 flux = fourth*flux
301C
302 iad1 = iad(1,nl)
303 fthesky(iad1) = flux
304 iad2 = iad(2,nl)
305 fthesky(iad2) = flux
306 iad3 = iad(3,nl)
307 fthesky(iad3) = flux
308 iad4 = iad(4,nl)
309 fthesky(iad4) = flux
310C
311 ELSEIF( n3 > 0) THEN !TRUE TRIANGLES.
312 nx= (x(2,n3)-x(2,n1))*(x(3,n3)-x(3,n2))
313 + -(x(3,n3)-x(3,n1))*(x(2,n3)-x(2,n2))
314 ny= (x(3,n3)-x(3,n1))*(x(1,n3)-x(1,n2))
315 + -(x(1,n3)-x(1,n1))*(x(3,n3)-x(3,n2))
316 nz= (x(1,n3)-x(1,n1))*(x(2,n3)-x(2,n2))
317 + -(x(2,n3)-x(2,n1))*(x(1,n3)-x(1,n2))
318C
319 area = half*sqrt(nx*nx + ny*ny + nz*nz)
320 flux = area*flux_dens*fcy*dt1a
321 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
322 flux = third*flux
323C
324 iad1 = iad(1,nl)
325 fthesky(iad1) = flux
326 iad2 = iad(2,nl)
327 fthesky(iad2) = flux
328 iad3 = iad(3,nl)
329 fthesky(iad3) = flux
330C
331 ELSE !ANALYSE 2D
332 ny= -x(3,n2)+x(3,n1)
333 nz= x(2,n2)-x(2,n1)
334C
335 area = sqrt(ny*ny + nz*nz)
336 flux = area*flux_dens*fcy*dt1a
337 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
338 flux = half*flux
339C
340 iad1 = iad(1,nl)
341 fthesky(iad1) = flux
342 iad2 = iad(2,nl)
343 fthesky(iad2) = flux
344 ENDIF
345C
346 ELSE ! IFLAG=0
347 iad1 = iad(1,nl)
348 fthesky(iad1) = zero
349 iad2 = iad(2,nl)
350 fthesky(iad2) = zero
351 IF(n4 > 0)THEN
352 iad3 = iad(3,nl)
353 fthesky(iad3) = zero
354 iad4 = iad(4,nl)
355 fthesky(iad4) = zero
356 ELSEIF(n3 > 0)THEN
357 iad3 = iad(3,nl)
358 fthesky(iad3) = zero
359 ENDIF
360 ENDIF
361 ELSE
362C----------------------------
363C IMPOSED VOLUMIC FLUX
364C----------------------------
365 WRITE(iout,'(//A)') ' VOLUMIC HEAT FLUX IS NOT
366 . COMPATIBLE WITH /PARITH/ON: USE /PARITH/OFF'
367 WRITE(6,*) ' VOLUMIC HEAT FLUX IS NOT ',
368 . 'COMPATIBLE WITH /PARITH/ON: USE /PARITH/OFF'
369 CALL flush(6)
370 CALL arret(2)
371 ENDIF
372 ENDDO
373C
374 ENDIF
375C
376 RETURN
377 END
my_real
#define my_real
Definition cppsort.cpp:32
fixflux
subroutine fixflux(ibfflux, fbfflux, npc, tf, x, ixs, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition fixflux.F:40
s4volume
subroutine s4volume(x, vol, nel, nc1, nc2, nc3, nc4)
Definition s4volume.F:30
s8evolume
subroutine s8evolume(x, volg, volp, nela, nptr, npts, nptt, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition s8evolume.F:31
arret
subroutine arret(nn)
Definition arret.F:87