OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
finter.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#include "my_real.inc"
24!||====================================================================
25!|| finter ../engine/source/tools/curve/finter.F
26!||--- called by ------------------------------------------------------
27!|| alefvm_grav_init ../engine/source/ale/alefvm/alefvm_grav_init.F
28!|| cfield_1 ../engine/source/loads/general/load_centri/cfield.F
29!|| cfield_imp ../engine/source/loads/general/load_centri/cfield_imp.F
30!|| cmain3 ../engine/source/materials/mat_share/cmain3.F
31!|| cmain3pinch ../engine/source/elements/shell/coqueba/cmain3pinch.F
32!|| convec ../engine/source/constraints/thermic/convec.F
33!|| daasolv ../engine/source/fluid/daasolv.F
34!|| daasolvp ../engine/source/fluid/daasolvp.F
35!|| dam_fld_sol ../engine/source/output/h3d/h3d_results/h3d_sol_skin_scalar.F
36!|| ebcs11_propellant ../engine/source/boundary_conditions/ebcs/ebcs11_propellant.F90
37!|| fail_biquad_b ../engine/source/materials/fail/biquad/fail_biquad_b.F
38!|| fail_biquad_c ../engine/source/materials/fail/biquad/fail_biquad_c.F
39!|| fail_biquad_ib ../engine/source/materials/fail/biquad/fail_biquad_ib.F
40!|| fail_biquad_s ../engine/source/materials/fail/biquad/fail_biquad_s.F
41!|| fail_connect ../engine/source/materials/fail/connect/fail_connect.F
42!|| fail_energy_b ../engine/source/materials/fail/energy/fail_energy_b.F
43!|| fail_energy_c ../engine/source/materials/fail/energy/fail_energy_c.F
44!|| fail_energy_ib ../engine/source/materials/fail/energy/fail_energy_ib.F
45!|| fail_energy_s ../engine/source/materials/fail/energy/fail_energy_s.F
46!|| fail_fabric_c ../engine/source/materials/fail/fabric/fail_fabric_c.F
47!|| fail_fld_c ../engine/source/materials/fail/fld/fail_fld_c.F
48!|| fail_fld_tsh ../engine/source/materials/fail/fld/fail_fld_tsh.F
49!|| fail_fld_xfem ../engine/source/materials/fail/fld/fail_fld_xfem.F
50!|| fail_gene1_b ../engine/source/materials/fail/gene1/fail_gene1_b.F90
51!|| fail_gene1_c ../engine/source/materials/fail/gene1/fail_gene1_c.F
52!|| fail_gene1_ib ../engine/source/materials/fail/gene1/fail_gene1_ib.F90
53!|| fail_gene1_s ../engine/source/materials/fail/gene1/fail_gene1_s.F
54!|| fail_nxt_c ../engine/source/materials/fail/nxt/fail_nxt_c.F
55!|| fail_orthbiquad_c ../engine/source/materials/fail/orthbiquad/fail_orthbiquad_c.F
56!|| fail_orthbiquad_s ../engine/source/materials/fail/orthbiquad/fail_orthbiquad_s.F
57!|| fail_orthstrain ../engine/source/materials/fail/orthstrain/fail_orthstrain_s.F
58!|| fail_orthstrain_c ../engine/source/materials/fail/orthstrain/fail_orthstrain_c.F
59!|| fail_sahraei_s ../engine/source/materials/fail/sahraei/fail_sahraei_s.F
60!|| fail_snconnect ../engine/source/materials/fail/snconnect/fail_snconnect.F
61!|| fail_syazwan_c ../engine/source/materials/fail/syazwan/fail_syazwan_c.F
62!|| fail_syazwan_s ../engine/source/materials/fail/syazwan/fail_syazwan_s.F
63!|| fail_tab2_b ../engine/source/materials/fail/tabulated/fail_tab2_b.F90
64!|| fail_tab2_c ../engine/source/materials/fail/tabulated/fail_tab2_c.F
65!|| fail_tab2_ib ../engine/source/materials/fail/tabulated/fail_tab2_ib.F90
66!|| fail_tab2_s ../engine/source/materials/fail/tabulated/fail_tab2_s.F
67!|| fail_tab_c ../engine/source/materials/fail/tabulated/fail_tab_c.F
68!|| fail_tab_old_c ../engine/source/materials/fail/tabulated/fail_tab_old_c.F
69!|| fail_tab_old_s ../engine/source/materials/fail/tabulated/fail_tab_old_s.F
70!|| fail_tab_old_xfem ../engine/source/materials/fail/tabulated/fail_tab_old_xfem.F
71!|| fail_tab_s ../engine/source/materials/fail/tabulated/fail_tab_s.F
72!|| fail_tab_xfem ../engine/source/materials/fail/tabulated/fail_tab_xfem.F
73!|| fail_tensstrain_b ../engine/source/materials/fail/tensstrain/fail_tensstrain_b.F
74!|| fail_tensstrain_c ../engine/source/materials/fail/tensstrain/fail_tensstrain_c.F
75!|| fail_tensstrain_ib ../engine/source/materials/fail/tensstrain/fail_tensstrain_ib.F
76!|| fail_tensstrain_s ../engine/source/materials/fail/tensstrain/fail_tensstrain_s.F
77!|| fail_visual_b ../engine/source/materials/fail/visual/fail_visual_b.F90
78!|| fail_visual_ib ../engine/source/materials/fail/visual/fail_visual_ib.F90
79!|| finter_mixed_mod ../engine/source/tools/finter_mixed.F90
80!|| fixflux ../engine/source/constraints/thermic/fixflux.F
81!|| force ../engine/source/loads/general/force.F90
82!|| forcefingeo ../engine/source/loads/general/forcefingeo.F
83!|| forcepinch ../engine/source/loads/general/forcepinch.F
84!|| frictionparts_model_isot ../engine/source/interfaces/int07/frictionparts_model.F
85!|| fxgrvcor ../engine/source/constraints/fxbody/fxgrvcor.F
86!|| gravit ../engine/source/loads/general/grav/gravit.F
87!|| gravit_fvm_fem ../engine/source/loads/general/grav/gravit_fvm_fem.F
88!|| gravit_imp ../engine/source/loads/general/grav/gravit_imp.F
89!|| h3d_pre_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
90!|| h3d_skin_vector ../engine/source/output/h3d/h3d_results/h3d_skin_vector.f
91!|| i11therm ../engine/source/interfaces/int11/i11therm.F
92!|| i21for3 ../engine/source/interfaces/int21/i21for3.F
93!|| i21therm ../engine/source/interfaces/int21/i21therm.F
94!|| i23mainf ../engine/source/interfaces/int23/i23mainf.F
95!|| i25therm ../engine/source/interfaces/int25/i25therm.F
96!|| i6ass3 ../engine/source/interfaces/inter3d/i6ass3.F
97!|| i7therm ../engine/source/interfaces/int07/i7therm.F
98!|| idx_fld_sol ../engine/source/output/h3d/h3d_results/h3d_sol_skin_scalar.F
99!|| imp_kpres ../engine/source/implicit/imp_glob_k.F
100!|| incpflow ../engine/source/fluid/incpflow.F
101!|| lag_fxv ../engine/source/tools/lagmul/lag_fxv.F
102!|| lag_fxvp ../engine/source/tools/lagmul/lag_fxv.F
103!|| lech3d ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
104!|| lectur ../engine/source/input/lectur.F
105!|| load_pressure ../engine/source/loads/general/load_pressure/load_pressure.F
106!|| m11law ../engine/source/materials/mat/mat011/m11law.F
107!|| m21law ../engine/source/materials/mat/mat021/m21law.F
108!|| mmain ../engine/source/materials/mat_share/mmain.F90
109!|| pfluid ../engine/source/loads/general/pfluid/pfluid.F
110!|| pforc3 ../engine/source/elements/beam/pforc3.F
111!|| r26sig ../engine/source/elements/spring/r26sig.F
112!|| r27def3 ../engine/source/elements/spring/r27def3.F
113!|| radiation ../engine/source/constraints/thermic/radiation.F
114!|| ruptint2 ../engine/source/interfaces/interf/ruptint2.F
115!|| sigeps100 ../engine/source/materials/mat/mat100/sigeps100.F90
116!|| sigeps101 ../engine/source/materials/mat/mat101/sigeps101.F
117!|| sigeps105 ../engine/source/materials/mat/mat105/sigeps105.F
118!|| sigeps111 ../engine/source/materials/mat/mat111/sigeps111.F
119!|| sigeps117 ../engine/source/materials/mat/mat117/sigeps117.F
120!|| sigeps187 ../engine/source/materials/mat/mat187/sigeps187.F
121!|| sigeps28 ../engine/source/materials/mat/mat028/sigeps28.F
122!|| sigeps33 ../engine/source/materials/mat/mat033/sigeps33.F
123!|| sigeps34c ../engine/source/materials/mat/mat034/sigeps34c.F
124!|| sigeps35 ../engine/source/materials/mat/mat035/sigeps35.F
125!|| sigeps35c ../engine/source/materials/mat/mat035/sigeps35c.F
126!|| sigeps36 ../engine/source/materials/mat/mat036/sigeps36.F
127!|| sigeps36g ../engine/source/materials/mat/mat036/sigeps36g.F
128!|| sigeps36pi ../engine/source/materials/mat/mat036/sigeps36pi.F
129!|| sigeps37 ../engine/source/materials/mat/mat037/sigeps37.F
130!|| sigeps38 ../engine/source/materials/mat/mat038/sigeps38.F
131!|| sigeps40 ../engine/source/materials/mat/mat040/sigeps40.F
132!|| sigeps42 ../engine/source/materials/mat/mat042/sigeps42.F
133!|| sigeps43c ../engine/source/materials/mat/mat043/sigeps43c.F
134!|| sigeps43g ../engine/source/materials/mat/mat043/sigeps43g.F
135!|| sigeps44p ../engine/source/materials/mat/mat044/sigeps44p.f
136!|| sigeps44t ../engine/source/materials/mat/mat044/sigeps44t.F
137!|| sigeps45 ../engine/source/materials/mat/mat045/sigeps45.F
138!|| sigeps45c ../engine/source/materials/mat/mat045/sigeps45c.F
139!|| sigeps51 ../engine/source/materials/mat/mat051/sigeps51.F90
140!|| sigeps51_boundary_material ../engine/source/materials/mat/mat051/sigeps51_boundary_material.F90
141!|| sigeps52c ../engine/source/materials/mat/mat052/sigeps52c.F
142!|| sigeps55c ../engine/source/materials/mat/mat055/sigeps55c.F
143!|| sigeps56c ../engine/source/materials/mat/mat056/sigeps56c.F
144!|| sigeps58c ../engine/source/materials/mat/mat058/sigeps58c.F
145!|| sigeps59 ../engine/source/materials/mat/mat059/sigeps59.F
146!|| sigeps60 ../engine/source/materials/mat/mat060/sigeps60.F
147!|| sigeps60c ../engine/source/materials/mat/mat060/sigeps60c.F
148!|| sigeps60g ../engine/source/materials/mat/mat060/sigeps60g.F
149!|| sigeps62 ../engine/source/materials/mat/mat062/sigeps62.F
150!|| sigeps62c ../engine/source/materials/mat/mat062/sigeps62c.F
151!|| sigeps63c ../engine/source/materials/mat/mat063/sigeps63c.F
152!|| sigeps64c ../engine/source/materials/mat/mat064/sigeps64c.F
153!|| sigeps65 ../engine/source/materials/mat/mat065/sigeps65.F
154!|| sigeps65c ../engine/source/materials/mat/mat065/sigeps65c.F
155!|| sigeps66 ../engine/source/materials/mat/mat066/sigeps66.F
156!|| sigeps66c ../engine/source/materials/mat/mat066/sigeps66c.F
157!|| sigeps68 ../engine/source/materials/mat/mat068/sigeps68.f
158!|| sigeps69 ../engine/source/materials/mat/mat069/sigeps69.F
159!|| sigeps70 ../engine/source/materials/mat/mat070/sigeps70.F
160!|| sigeps71c ../engine/source/materials/mat/mat071/sigeps71c.F
161!|| sigeps73c ../engine/source/materials/mat/mat073/sigeps73c.F
162!|| sigeps74 ../engine/source/materials/mat/mat074/sigeps74.F
163!|| sigeps75 ../engine/source/materials/mat/mat075/sigeps75.F
164!|| sigeps77 ../engine/source/materials/mat/mat077/sigeps77.F
165!|| sigeps78 ../engine/source/materials/mat/mat078/sigeps78.F
166!|| sigeps80 ../engine/source/materials/mat/mat080/sigeps80.F
167!|| sigeps80c ../engine/source/materials/mat/mat080/sigeps80c.F
168!|| sigeps82 ../engine/source/materials/mat/mat082/sigeps82.F
169!|| sigeps82c ../engine/source/materials/mat/mat082/sigeps82c.F
170!|| sigeps83 ../engine/source/materials/mat/mat083/sigeps83.F
171!|| sigeps85c_void ../engine/source/materials/mat/mat085/sigeps85c_void.F
172!|| sigeps86c ../engine/source/materials/mat/mat086/sigeps86c.F
173!|| sigeps92 ../engine/source/materials/mat/mat092/sigeps92.F
174!|| sigeps94 ../engine/source/materials/mat/mat094/sigeps94.F
175!|| sigeps95 ../engine/source/materials/mat/mat095/sigeps95.F
176!|| sms_gravit ../engine/source/ams/sms_gravit.F
177!|| sortie_main ../engine/source/output/sortie_main.F
178!|| thermexpc ../engine/source/materials/mat_share/thermexpc.F
179!||====================================================================
180 my_real FUNCTION finter(IFUNC,XX,NPF,TF,DERI)
181!$COMMENT
182! FINTER description :
183! FINTER function interpolates XX on TF curve
184! and computes also the derivative DERI
185! FINTER organization :
186! two cases :
187! - constant function --> direct interpolation
188! - Non-confunction:
189! (1): if the number of point in the function is < MIN_GAP, then
190! the interpolation is computed
191! (2): if the number of point in the function is > MIN_GAP, then
192! a dichotmy reduces the point interval and a interpolation
193! is performed on the reduced point interval
194! if the dichotomy fails, then the classical interpolation
195! is used
196!$ENDCOMMENT
197C-----------------------------------------------
198C I m p l i c i t T y p e s
199C-----------------------------------------------
200#include "implicit_f.inc"
201! ----------------------------------------
202! Global variables
203! ----------------------------------------
204 INTEGER ifunc,npf(*)
205 my_real tf(*),deri,xx
206! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
207! IFUNC : integer ; function number
208! NPF : integer ; dimension=SUM( (number of point[IFUNC])*2), IFUNC=1:MAX_FUNC
209! pointer for the function points x + function value f(x)
210! TF : my_real ; dimension=SUM( (number of point[IFUNC])*2), IFUNC=1:MAX_FUNC
211! gives the function points x + function value f(x)
212! DERI : my_real ; function derivative
213! XX : my_real ; x value to be interpolate
214! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
215! ----------------------------------------
216! Local variables
217! ----------------------------------------
218 LOGICAL :: bool
219 INTEGER :: i,j,point_nbr
220 INTEGER :: first, last, middle
221 INTEGER :: min_gap
222 INTEGER :: counter
223 my_real :: dx1,dx2,dx2_first,dx2_last,dx2_middle
224 my_real :: product_fm,product_ml
225 my_real :: div, div0
226
227! ----------------------------------------
228 finter = zero
229 min_gap = 20
230 dx2 = tf(npf(ifunc)) - xx
231 ! -----------------------------
232 IF ((npf(ifunc+1)-npf(ifunc))==2) THEN
233 ! Constant Function
234 finter = tf(npf(ifunc)+1)
235 RETURN
236 ELSE
237 ! -----------------------------
238 ! check the number of point in the function:
239 ! if point_nbt < MIN_GAP --> classical interpolation
240 ! if point_nbt > MIN_GAP --> dichotomy in order to reduce the point number interval
241 ! and then when the interval is < MIN_GAP --> classical interpolation
242 ! -----------------------------
243 point_nbr = ( npf(ifunc+1)-2 - (npf(ifunc)+2) ) / 2 + 1
244 IF(point_nbr<min_gap) THEN
245 ! -----------------------------
246 ! classical interpolation
247 DO i=npf(ifunc)+2,npf(ifunc+1)-2,2
248 dx1 = -dx2
249 dx2 = tf(i) - xx
250 IF(dx2>=zero.OR.i==npf(ifunc+1)-2)THEN
251 div0 = tf(i) - tf(i-2)
252 div = max(abs(div0),em16)
253 div = sign(div,div0)
254 deri = (tf(i+1) - tf(i-1)) / div
255 IF(dx1<=dx2)THEN
256 finter = tf(i-1) + dx1 * deri
257 ELSE
258 finter = tf(i+1) - dx2 * deri
259 ENDIF
260 RETURN
261 ENDIF
262 ENDDO
263 ! -----------------------------
264 ELSE
265 ! -----------------------------
266 ! dichotomy
267 ! first shot : (a) we check the first value
268
269 dx2 = tf(npf(ifunc)) - xx
270 i=npf(ifunc)+2
271 dx1 = -dx2
272 dx2 = tf(i) - xx
273 IF(dx2>=zero.OR.i==npf(ifunc+1)-2)THEN
274 div0 = tf(i) - tf(i-2)
275 div = max(abs(div0),em16)
276 div = sign(div,div0)
277 deri = (tf(i+1) - tf(i-1)) / div
278 IF(dx1<=dx2)THEN
279 finter = tf(i-1) + dx1 * deri
280 ELSE
281 finter = tf(i+1) - dx2 * deri
282 ENDIF
283 RETURN
284 ENDIF
285
286 ! first shot : (b) we check the last value
287 dx2 = tf(npf(ifunc+1)-2) - xx
288 i=npf(ifunc+1)-2
289 dx1 = -dx2
290 dx2 = tf(i) - xx
291 IF(dx2 <= zero)THEN
292 div0 = tf(i) - tf(i-2)
293 div = max(abs(div0),em16)
294 div = sign(div,div0)
295 deri = (tf(i+1) - tf(i-1)) / div
296 IF(dx1 == zero .AND. dx2 == zero) THEN
297 finter = tf(i+1)
298 ELSEIF(dx1<=dx2)THEN
299 finter = tf(i-1) + dx1 * deri
300 ELSE
301 finter = tf(i+1) - dx2 * deri
302 ENDIF
303 RETURN
304 ENDIF
305
306
307 ! -----------------------------
308 ! second shot : (a) dichotomy in order to reduce the gap
309 first = 1
310 last = point_nbr
311 bool=.true.
312 dx2 = tf(npf(ifunc)) - xx
313 counter = 0
314
315 DO WHILE(bool)
316 middle = (last - first) / 2 + first
317 dx2_first= tf(npf(ifunc)+2*first) - xx
318 dx2_last= tf(npf(ifunc)+2*last) - xx
319 dx2_middle= tf(npf(ifunc)+2*middle) - xx
320
321
322 product_fm = dx2_first*dx2_middle
323 product_ml = dx2_middle*dx2_last
324
325 IF(product_fm<0) THEN
326 last=middle
327 ELSEIF(product_ml<0) THEN
328 first=middle
329 ELSE
330 bool=.false.
331 ENDIF
332 IF( (last-first)<min_gap) bool=.false.
333 ! ---------------------
334 ! check in order to avoid infinite loop
335 counter = counter + 1
336 IF( counter>point_nbr ) THEN
337 ! INFINITE LOOP DETECTED
338 counter = -1
339 bool=.false.
340 ENDIF
341 ! ---------------------
342 ENDDO
343 ! -----------------------------
344 ! second shot : (b) classical interpolation with reduced interval
345
346 ! ------------------------
347 ! INFINITE LOOP DETECTED
348 ! the dichotomy failed to reduce the interval, back to old treatment
349 IF( counter == -1 ) THEN
350 first = 1
351 last = point_nbr
352 ENDIF
353 ! ------------------------
354 dx2 = tf(npf(ifunc)+2*first-2) - xx
355 DO j=first,last
356 i=npf(ifunc)+2*j
357 dx1 = -dx2
358 dx2 = tf(i) - xx
359 IF(dx2>=zero.OR.j==last)THEN
360 div0 = tf(i) - tf(i-2)
361 div = max(abs(div0),em16)
362 div = sign(div,div0)
363
364 deri = (tf(i+1) - tf(i-1)) / div
365 IF(dx1<=dx2)THEN
366 finter = tf(i-1) + dx1 * deri
367 ELSE
368 finter = tf(i+1) - dx2 * deri
369 ENDIF
370 RETURN
371 ENDIF
372 ENDDO
373 ! -----------------------------
374 ENDIF ! end of point_nbr < MIN_GAP
375 END IF ! end of constant function
376C
377 RETURN
378 END
379! ----------------------------------------
#define my_real
Definition cppsort.cpp:32
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine h3d_skin_vector(skin_vector, nodal_ipart, nsensor, is_written_skin, h3d_part, info1, keyword, ib, iloadp, lloadp, fac, npc, tf, sensor_tab, tagncont, loadp_hyd_inter, forc, xframe, x, v, imapskp, loads, table, iframe, dis, pblast)
#define max(a, b)
Definition macros.h:21
subroutine sigeps44p(nel, ngl, mat, pid, nuparam, uparam, geo, off, pla, al, exx, exy, exz, kxx, kyy, kzz, fa1, fa2, fa3, ma1, ma2, ma3, for, mom, pm, nuvar, uvar, nfunc, ifunc, tf, npf, sigy)
Definition sigeps44p.F:37
subroutine sigeps68(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, rho0, rho, volume, eint, fr_wav, epspxx, epspyy, epspzz, epspxy, epspyz, epspzx, depsxx, depsyy, depszz, depsxy, depsyz, depszx, epsxx, epsyy, epszz, epsxy, epsyz, epszx, sigoxx, sigoyy, sigozz, sigoxy, sigoyz, sigozx, signxx, signyy, signzz, signxy, signyz, signzx, sigvxx, sigvyy, sigvzz, sigvxy, sigvyz, sigvzx, soundsp, viscmax, uvar, off, ngl, ipt, ipm, mat, amu)
Definition sigeps68.F:44