OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
finter_smooth.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_smooth ../engine/source/tools/curve/finter_smooth.F
26!||--- called by ------------------------------------------------------
27!|| daasolv ../engine/source/fluid/daasolv.F
28!|| daasolvp ../engine/source/fluid/daasolvp.F
29!|| ebcs11_propellant ../engine/source/boundary_conditions/ebcs/ebcs11_propellant.F90
30!|| finter_mixed_mod ../engine/source/tools/finter_mixed.F90
31!|| force ../engine/source/loads/general/force.F90
32!|| forcefingeo ../engine/source/loads/general/forcefingeo.F
33!|| forcepinch ../engine/source/loads/general/forcepinch.F
34!|| gravit ../engine/source/loads/general/grav/gravit.F
35!|| gravit_fvm_fem ../engine/source/loads/general/grav/gravit_fvm_fem.F
36!|| gravit_imp ../engine/source/loads/general/grav/gravit_imp.F
37!|| h3d_pre_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
38!|| h3d_skin_vector ../engine/source/output/h3d/h3d_results/h3d_skin_vector.F
39!|| incpflow ../engine/source/fluid/incpflow.F
40!|| lag_fxv ../engine/source/tools/lagmul/lag_fxv.F
41!|| lag_fxvp ../engine/source/tools/lagmul/lag_fxv.F
42!||====================================================================
43 my_real FUNCTION finter_smooth(IFUNC,XX,NPF,TF,DERI)
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER ifunc,npf(*),i
52 my_real tf(*),deri,xx,deri1,deri2,deri3,dx1,dx2,div0,div,xx_first,xx_last
53C-----------------------------------------------
54C B o d y
55C-----------------------------------------------
56 finter_smooth = zero
57!
58! smooth interpolation
59!
60 dx2 = tf(npf(ifunc)) - xx
61 xx_first = tf(npf(ifunc))
62 xx_last = tf(npf(ifunc+1)-2)
63!
64 IF ((npf(ifunc+1)-npf(ifunc)) == 2) THEN
65! Constant Function
66 finter_smooth = tf(npf(ifunc)+1)
67 RETURN
68 ELSE
69!--------------
70 DO i=npf(ifunc)+2,npf(ifunc+1)-2,2
71 IF (xx <= xx_first) THEN
72 finter_smooth = tf(npf(ifunc)+1)
73 RETURN
74 ELSEIF (xx >= xx_last) THEN
75 finter_smooth = tf(npf(ifunc+1)-1)
76 RETURN
77 ELSEIF (xx_first < xx .AND. xx < xx_last) THEN
78! within interval
79!! DX1 = -DX2
80 dx1 = xx - tf(i-2)
81 dx2 = tf(i) - xx
82 IF (dx2 >= zero .OR. i == npf(ifunc+1)-2) THEN
83 div0 = tf(i) - tf(i-2)
84 div = max(abs(div0),em16)
85 div = sign(div,div0)
86 IF (dx1 <= dx2) THEN
87!! DERI= DX1/(TF(I)-TF(I-2))
88 deri= dx1 / div
89 deri1 = deri
90 deri2 = deri1*deri1
91 deri3 = deri1*deri2
92 finter_smooth = tf(i-1) + (tf(i+1)-tf(i-1))*deri3*
93 . (10. - 15.*deri1 + 6.*deri2)
94 ELSE
95!! DERI= DX2/(TF(I)-TF(I-2))
96 deri= dx2 / div
97 deri1 = deri
98 deri2 = deri1*deri1
99 deri3 = deri1*deri2
100 finter_smooth = tf(i+1) - (tf(i+1)-tf(i-1))*deri3*
101 . (10. - 15.*deri1 + 6.*deri2)
102 ENDIF ! IF (DX1 <= DX2)
103 RETURN
104 ENDIF ! IF (DX2 >= ZERO .OR. I == NPF(IFUNC+1)-2)
105 ENDIF ! IF (XX <= XX_FIRST)
106 ENDDO ! DO I=NPF(IFUNC)+2,NPF(IFUNC+1)-2,2
107 ENDIF ! IF ((NPF(IFUNC+1)-NPF(IFUNC)) == 2)
108!---
109 RETURN
110 END
111!||====================================================================
112!|| finter2_smooth ../engine/source/tools/curve/finter_smooth.F
113!||--- called by ------------------------------------------------------
114!|| fixfingeo ../engine/source/constraints/general/impvel/fixfingeo.F
115!||====================================================================
116 my_real FUNCTION finter2_smooth(TF,IAD,IPOS,ILEN,XX,DYDX)
117C-----------------------------------------------
118C I m p l i c i t T y p e s
119C-----------------------------------------------
120#include "implicit_f.inc"
121 INTEGER j,j1,j2,icont,ilen,ipos,iad
122 my_real tf(2,*),dydx,xx,dydx1,dydx2,dydx3
123C-----------------------------------------------
124 j = 0
125 icont = 1
126 DO WHILE (icont == 1)
127 j = j+1
128 icont = 0
129 j1 = ipos+iad+1
130 IF (j <= ilen-1 .AND. xx > tf(1,j1)) THEN
131 ipos = ipos + 1
132 icont = 1
133 ELSEIF (ipos >= 1 .AND. xx < tf(1,j1-1)) THEN
134 ipos = ipos - 1
135 icont = 1
136 ENDIF
137 ENDDO ! DO WHILE (ICONT == 1)
138!
139! smooth interpolation
140!
141 j1 = iad + ipos
142 j2 = j1+1
143 dydx = (xx-tf(1,j1))/(tf(1,j2)-tf(1,j1))
144!
145 dydx1 = dydx
146 dydx2 = dydx1*dydx1
147 dydx3 = dydx1*dydx2
148!
149 finter2_smooth = tf(2,j1) + (tf(2,j2)-tf(2,j1))*dydx3*
150 . (10. - 15.*dydx1 + 6.*dydx2)
151!
152!! FINTER2_SMOOTH = TF(2,J1) + (TF(2,J2)-TF(2,J1))*DYDX**3*
153!! . (10. - 15.*DYDX + 6.*DYDX**2)
154!---
155 RETURN
156 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21