OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fixflux.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fixflux (ibfflux, fbfflux, npc, tf, x, ixs, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)

Function/Subroutine Documentation

◆ fixflux()

subroutine fixflux ( integer, dimension(glob_therm%nitflux,*) ibfflux,
fbfflux,
integer, dimension(*) npc,
tf,
x,
integer, dimension(nixs,*) ixs,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor) sensor_tab,
fthe,
integer, dimension(4,*) iad,
fthesky,
type(python_) python,
type (glob_therm_), intent(inout) glob_therm )

Definition at line 38 of file fixflux.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE python_funct_mod
45 USE sensor_mod
46 use glob_therm_mod
47 use element_mod , only : nixs
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "com08_c.inc"
59#include "parit_c.inc"
60#include "units_c.inc"
61C-----------------------------------------------,
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 type (glob_therm_) ,intent(inout) :: glob_therm
65 INTEGER ,INTENT(IN) :: NSENSOR
66 INTEGER NPC(*),IAD(4,*)
67 INTEGER IBFFLUX(GLOB_THERM%NITFLUX,*)
68 INTEGER IXS(NIXS,*)
69 my_real
70 . fbfflux(glob_therm%LFACTHER,*), tf(*), x(3,*),
71 . fthesky(lsky), fthe(*)
72 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
73 TYPE(PYTHON_) :: PYTHON
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER NL, N1, N2, N3, N4, N5, N6, N7, N8, ISENS,
78 . IFUNC_OLD,IFUNC,IAD1,IAD2,IAD3,IAD4,IFLAG
79 INTEGER IEL
80 my_real nx, ny, nz, dydx, ts, flux, ts_old, fcx, fcy, flux_dens, area
81 my_real startt, stopt, fcy_old
82 my_real tta, ttb, dt1a, dt1n, volg, bid
83 my_real finter
84 EXTERNAL finter
85 INTEGER :: ISMOOTH
86C=======================================================================
87 ifunc_old = 0
88 ts_old = zero
89 fcy_old = zero
90 flux_dens = zero
91 n4 = zero
92 dt1n = zero
93C
94 IF(iparit == 0) THEN
95C-----------------------------------------------------------
96C CODE PARITH/OFF NE PAS OUBLIER LE CODE P/ON !
97C-----------------------------------------------------------
98 DO nl=1,glob_therm%NFXFLUX
99C
100 isens = ibfflux(6,nl)
101C
102 startt = fbfflux(4,nl)
103 stopt = fbfflux(5,nl)
104 tta = tt *glob_therm%THEACCFACT
105 dt1a = dt1*glob_therm%THEACCFACT
106 ttb = tta - dt1a
107 IF(isens == 0)THEN
108 ts = tta - startt
109 ELSE
110 startt = startt + sensor_tab(isens)%TSTART
111 stopt = stopt + sensor_tab(isens)%TSTART
112 ts = tta - startt
113 ENDIF
114C
115 IF(tta < startt .OR. ttb >= stopt) cycle
116 IF(tta > stopt ) THEN
117 IF(ttb <= startt) THEN
118 dt1n = stopt - startt
119 ELSE
120 dt1n = stopt - ttb
121 ENDIF
122 ELSEIF(tta <= stopt) THEN
123 IF(ttb <= startt) THEN
124 dt1n = tta - startt
125 ELSE
126 dt1n = dt1a
127 ENDIF
128 ENDIF
129C
130 ifunc = ibfflux(5,nl)
131 fcy = fbfflux(1,nl)
132 fcx = fbfflux(2,nl)
133 IF(ifunc_old /= ifunc .OR. ts_old /= ts .OR. fcy_old /= fcy ) THEN
134 ismooth = 0
135 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
136 IF(ismooth < 0) THEN
137 CALL python_call_funct1d(python, -ismooth,ts*fcx, flux_dens)
138 flux_dens = fcy*flux_dens
139 ELSE
140 flux_dens = fcy*finter(ifunc, ts*fcx,npc,tf,dydx)
141 ENDIF
142 ifunc_old = ifunc
143 ts_old = ts
144 fcy_old = fcy
145 ENDIF
146C----------------------------
147C IMPOSED SURFACIC FLUX
148C----------------------------
149 IF(ibfflux(10,nl) == 0) THEN
150 n1 = ibfflux(1,nl)
151 n2 = ibfflux(2,nl)
152 n3 = ibfflux(3,nl)
153 n4 = ibfflux(4,nl)
154C ANALYSE 3D
155 IF(n4 > 0)THEN ! QUAD
156C
157 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2))
158 + -(x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
159 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2))
160 + -(x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
161 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2))
162 + -(x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
163C
164 area = half*sqrt(nx*nx + ny*ny + nz*nz)
165 flux = area*flux_dens*dt1n
166 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
167 flux = fourth*flux
168C
169 fthe(n1) = fthe(n1) + flux
170 fthe(n2) = fthe(n2) + flux
171 fthe(n3) = fthe(n3) + flux
172 fthe(n4) = fthe(n4) + flux
173C
174 ELSEIF(n3 > 0) THEN !TRUE TRIANGLES
175 nx= (x(2,n3)-x(2,n1))*(x(3,n3)-x(3,n2))
176 + -(x(3,n3)-x(3,n1))*(x(2,n3)-x(2,n2))
177 ny= (x(3,n3)-x(3,n1))*(x(1,n3)-x(1,n2))
178 + -(x(1,n3)-x(1,n1))*(x(3,n3)-x(3,n2))
179 nz= (x(1,n3)-x(1,n1))*(x(2,n3)-x(2,n2))
180 + -(x(2,n3)-x(2,n1))*(x(1,n3)-x(1,n2))
181C
182 area = half*sqrt( nx*nx + ny*ny + nz*nz)
183 flux = area*flux_dens*dt1n
184 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
185 flux = third*flux
186C
187 fthe(n1) = fthe(n1) + flux
188 fthe(n2) = fthe(n2) + flux
189 fthe(n3) = fthe(n3) + flux
190C
191 ELSE !ANALYSE 2D
192 ny= -x(3,n2)+x(3,n1)
193 nz= x(2,n2)-x(2,n1)
194C
195 area = sqrt(ny*ny + nz*nz)
196 flux = area*flux_dens*dt1n
197 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
198 flux = half*flux
199C
200 fthe(n1) = fthe(n1) + flux
201 fthe(n2) = fthe(n2) + flux
202C
203 ENDIF
204C----------------------------
205C IMPOSED VOLUMIC FLUX
206C----------------------------
207 ELSE
208 iel = ibfflux(1,nl)
209 IF(iel == 0) THEN
210 ibfflux(1,nl)=ibfflux(8,nl)
211 iel = ibfflux(1,nl)
212 ENDIF
213 n1 = ixs(2,iel)
214 n2 = ixs(3,iel)
215 n3 = ixs(4,iel)
216 n4 = ixs(5,iel)
217 n5 = ixs(6,iel)
218 n6 = ixs(7,iel)
219 n7 = ixs(8,iel)
220 n8 = ixs(9,iel)
221
222 IF(n1 == n2 .AND. n3 == n4 .AND. n5 == n8 .AND. n6 == n7) THEN
223 CALL s4volume(x, volg, 1, n1, n3, n6, n5)
224 ELSE
225 CALL s8evolume(x, volg, bid, 1, 0, 0, 0, n1, n2, n3, n4, n5, n6, n7, n8)
226 ENDIF
227
228 flux = volg*flux_dens*dt1n
229 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
230 flux = one_over_8*flux
231C
232 fthe(n1) = fthe(n1) + flux
233 fthe(n2) = fthe(n2) + flux
234 fthe(n3) = fthe(n3) + flux
235 fthe(n4) = fthe(n4) + flux
236 fthe(n5) = fthe(n5) + flux
237 fthe(n6) = fthe(n6) + flux
238 fthe(n7) = fthe(n7) + flux
239 fthe(n8) = fthe(n8) + flux
240 ENDIF
241 ENDDO ! N=1,NFXFLUX
242C
243
244 ELSE
245C-------------------------
246C CODE PARITH/ON
247C CODE NON VECTORIEL
248C-------------------------
249 DO nl=1,glob_therm%NFXFLUX
250 isens = ibfflux(6,nl)
251 startt = fbfflux(4,nl)
252 stopt = fbfflux(5,nl)
253 tta = tt *glob_therm%THEACCFACT
254 dt1a = dt1*glob_therm%THEACCFACT
255 IF (isens == 0)THEN
256 ts = tta - startt
257 ELSE
258 startt = startt + sensor_tab(isens)%TSTART
259 stopt = stopt + sensor_tab(isens)%TSTART
260 ts = tta - startt
261 ENDIF
262 iflag = 1
263 IF(tta < startt) iflag = 0
264 IF(tta > stopt ) iflag = 0
265
266 IF(ibfflux(10,nl) == 0) THEN
267C----------------------------
268C IMPOSED SURFACIC FLUX
269C----------------------------
270 IF(iflag==1) THEN
271 n1 =ibfflux(1,nl)
272 n2 =ibfflux(2,nl)
273 n3 =ibfflux(3,nl)
274 n4 =ibfflux(4,nl)
275 ifunc = ibfflux(5,nl)
276 fcy = fbfflux(1,nl)
277 fcx = fbfflux(2,nl)
278 IF(ifunc_old /= ifunc .OR. ts_old /= ts) THEN
279 ismooth = 0
280 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
281 IF(ismooth < 0) THEN
282 CALL python_call_funct1d(python, -ismooth,ts*fcx, flux_dens)
283 ELSE
284 flux_dens = finter(ifunc,ts*fcx,npc,tf,dydx)
285 ENDIF
286 ifunc_old = ifunc
287 ts_old = ts
288 ENDIF
289C
290C ANALYSE 3D
291 IF(n4 > 0)THEN
292 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2))
293 + -(x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
294 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2))
295 + -(x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
296 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2))
297 + -(x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
298C
299 area = half*sqrt(nx*nx + ny*ny + nz*nz)
300 flux = area*flux_dens*fcy*dt1a
301 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
302 flux = fourth*flux
303C
304 iad1 = iad(1,nl)
305 fthesky(iad1) = flux
306 iad2 = iad(2,nl)
307 fthesky(iad2) = flux
308 iad3 = iad(3,nl)
309 fthesky(iad3) = flux
310 iad4 = iad(4,nl)
311 fthesky(iad4) = flux
312C
313 ELSEIF( n3 > 0) THEN !TRUE TRIANGLES.
314 nx= (x(2,n3)-x(2,n1))*(x(3,n3)-x(3,n2))
315 + -(x(3,n3)-x(3,n1))*(x(2,n3)-x(2,n2))
316 ny= (x(3,n3)-x(3,n1))*(x(1,n3)-x(1,n2))
317 + -(x(1,n3)-x(1,n1))*(x(3,n3)-x(3,n2))
318 nz= (x(1,n3)-x(1,n1))*(x(2,n3)-x(2,n2))
319 + -(x(2,n3)-x(2,n1))*(x(1,n3)-x(1,n2))
320C
321 area = half*sqrt(nx*nx + ny*ny + nz*nz)
322 flux = area*flux_dens*fcy*dt1a
323 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
324 flux = third*flux
325C
326 iad1 = iad(1,nl)
327 fthesky(iad1) = flux
328 iad2 = iad(2,nl)
329 fthesky(iad2) = flux
330 iad3 = iad(3,nl)
331 fthesky(iad3) = flux
332C
333 ELSE !ANALYSE 2D
334 ny= -x(3,n2)+x(3,n1)
335 nz= x(2,n2)-x(2,n1)
336C
337 area = sqrt(ny*ny + nz*nz)
338 flux = area*flux_dens*fcy*dt1a
339 glob_therm%HEAT_FFLUX = glob_therm%HEAT_FFLUX + flux
340 flux = half*flux
341C
342 iad1 = iad(1,nl)
343 fthesky(iad1) = flux
344 iad2 = iad(2,nl)
345 fthesky(iad2) = flux
346 ENDIF
347C
348 ELSE ! IFLAG=0
349 iad1 = iad(1,nl)
350 fthesky(iad1) = zero
351 iad2 = iad(2,nl)
352 fthesky(iad2) = zero
353 IF(n4 > 0)THEN
354 iad3 = iad(3,nl)
355 fthesky(iad3) = zero
356 iad4 = iad(4,nl)
357 fthesky(iad4) = zero
358 ELSEIF(n3 > 0)THEN
359 iad3 = iad(3,nl)
360 fthesky(iad3) = zero
361 ENDIF
362 ENDIF
363 ELSE
364C----------------------------
365C IMPOSED VOLUMIC FLUX
366C----------------------------
367 WRITE(iout,'(//A)') ' VOLUMIC HEAT FLUX IS NOT
368 . COMPATIBLE WITH /PARITH/ON: USE /PARITH/OFF'
369 WRITE(6,*) ' VOLUMIC HEAT FLUX IS NOT ',
370 . 'COMPATIBLE WITH /PARITH/ON: USE /PARITH/OFF'
371 CALL flush(6)
372 CALL arret(2)
373 ENDIF
374 ENDDO
375C
376 ENDIF
377C
378 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
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
nl
character *2 function nl()
Definition message.F:2360
arret
subroutine arret(nn)
Definition arret.F:86