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