OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
table_mat_vinterp.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!|| table_mat_vinterp_mod ../engine/source/materials/tools/table_mat_vinterp.F
25!||--- called by ------------------------------------------------------
26!|| asso_plas76 ../engine/source/materials/mat/mat076/asso_plas76.F
27!|| asso_qplas76c ../engine/source/materials/mat/mat076/asso_qplas76c.F
28!|| compaction_tab ../common_source/eos/compaction_tab.F90
29!|| compaction_tab_init ../common_source/eos/compaction_tab.F90
30!|| condamage ../engine/source/materials/mat/mat190/condamage.F
31!|| conversion ../engine/source/materials/mat/mat190/conversion.F
32!|| granular51 ../engine/source/materials/mat/mat051/granular51.F90
33!|| mat87c_tabulated ../engine/source/materials/mat/mat087/mat87c_tabulated.f90
34!|| mat87c_tabulated_3dir_ortho ../engine/source/materials/mat/mat087/mat87c_tabulated_3dir_ortho.F90
35!|| no_asso_lplas76c ../engine/source/materials/mat/mat076/no_asso_lplas76c.F
36!|| no_asso_plas76 ../engine/source/materials/mat/mat076/no_asso_plas76.F
37!|| no_asso_qplas76c ../engine/source/materials/mat/mat076/no_asso_qplas76c.F
38!|| s6zforc3 ../engine/source/elements/solid/solide6z/s6zforc3.F90
39!|| sigeps106 ../engine/source/materials/mat/mat106/sigeps106.F90
40!|| sigeps106c ../engine/source/materials/mat/mat106/sigeps106c.F90
41!|| sigeps128c ../engine/source/materials/mat/mat128/sigeps128c.F90
42!|| sigeps128s ../engine/source/materials/mat/mat128/sigeps128s.F90
43!|| sigeps129s ../engine/source/materials/mat/mat129/sigeps129s.F90
44!|| sigeps130 ../engine/source/materials/mat/mat130/sigeps130.F90
45!|| sigeps133 ../engine/source/materials/mat/mat133/sigeps133.F90
46!|| sigeps163 ../engine/source/materials/mat/mat163/sigeps163.F90
47!|| sigeps50s ../engine/source/materials/mat/mat050/sigeps50s.F90
48!|| sigeps57c ../engine/source/materials/mat/mat057/sigeps57c.F90
49!|| sigeps70 ../engine/source/materials/mat/mat070/sigeps70.F
50!|| sigeps88 ../engine/source/materials/mat/mat088/sigeps88.F90
51!|| sigeps88c ../engine/source/materials/mat/mat088/sigeps88c.F90
52!||====================================================================
53 MODULE table_mat_vinterp_mod
54 CONTAINS
55!||====================================================================
56!|| table_mat_vinterp ../engine/source/materials/tools/table_mat_vinterp.F
57!||--- called by ------------------------------------------------------
58!|| asso_plas76 ../engine/source/materials/mat/mat076/asso_plas76.F
59!|| asso_qplas76c ../engine/source/materials/mat/mat076/asso_qplas76c.F
60!|| compaction_tab ../common_source/eos/compaction_tab.F90
61!|| compaction_tab_init ../common_source/eos/compaction_tab.F90
62!|| condamage ../engine/source/materials/mat/mat190/condamage.F
63!|| conversion ../engine/source/materials/mat/mat190/conversion.F
64!|| granular51 ../engine/source/materials/mat/mat051/granular51.f90
65!|| mat87c_tabulated ../engine/source/materials/mat/mat087/mat87c_tabulated.F90
66!|| mat87c_tabulated_3dir_ortho ../engine/source/materials/mat/mat087/mat87c_tabulated_3dir_ortho.F90
67!|| no_asso_lplas76c ../engine/source/materials/mat/mat076/no_asso_lplas76c.F
68!|| no_asso_plas76 ../engine/source/materials/mat/mat076/no_asso_plas76.F
69!|| no_asso_qplas76c ../engine/source/materials/mat/mat076/no_asso_qplas76c.F
70!|| sigeps106 ../engine/source/materials/mat/mat106/sigeps106.F90
71!|| sigeps106c ../engine/source/materials/mat/mat106/sigeps106c.F90
72!|| sigeps128c ../engine/source/materials/mat/mat128/sigeps128c.F90
73!|| sigeps128s ../engine/source/materials/mat/mat128/sigeps128s.F90
74!|| sigeps129s ../engine/source/materials/mat/mat129/sigeps129s.F90
75!|| sigeps130 ../engine/source/materials/mat/mat130/sigeps130.F90
76!|| sigeps133 ../engine/source/materials/mat/mat133/sigeps133.F90
77!|| sigeps163 ../engine/source/materials/mat/mat163/sigeps163.F90
78!|| sigeps50s ../engine/source/materials/mat/mat050/sigeps50s.F90
79!|| sigeps57c ../engine/source/materials/mat/mat057/sigeps57c.F90
80!|| sigeps70 ../engine/source/materials/mat/mat070/sigeps70.F
81!|| sigeps88 ../engine/source/materials/mat/mat088/sigeps88.F90
82!|| sigeps88c ../engine/source/materials/mat/mat088/sigeps88c.F90
83!||--- calls -----------------------------------------------------
84!|| ancmsg ../engine/source/output/message/message.F
85!|| arret ../engine/source/system/arret.F
86!||--- uses -----------------------------------------------------
87!|| message_mod ../engine/share/message_module/message_mod.F
88!|| table4d_mod ../common_source/modules/table4d_mod.F
89!||====================================================================
90 SUBROUTINE table_mat_vinterp(TABLE,DIMX,NEL,IPOS,XX,YY,DYDX, OPT_EXTRAPOLATE)
91C-----------------------------------------------
92C D e s c r i p t i o n
93C-----------------------------------------------
94C This subroutine is proceeding to table interpolation.
95C example with case dim=1 (table <=> function)
96C nel is number interpolatation
97C ipos is index backup to prevent from starting the loop from 1 to npt during each cycle (input/output)
98C XX(nel) are abscissa on which the interpolation is required (input)
99C YY(nel) are the interpolated value (output)
100C DYDX(nel) is the slope (output)
101C-----------------------------------------------
102C M o d u l e s
103C-----------------------------------------------
104 USE table4d_mod
105 USE message_mod
106C-----------------------------------------------
107C I m p l i c i t T y p e s
108C-----------------------------------------------
109#include "implicit_f.inc"
110C-----------------------------------------------
111C D u m m y A r g u m e n t s
112C-----------------------------------------------
113 TYPE(table_4d_) ,INTENT(IN) :: TABLE
114 INTEGER, VALUE ,INTENT(IN) :: DIMX
115 INTEGER ,INTENT(IN) :: NEL
116 my_real, DIMENSION(DIMX,TABLE%NDIM),INTENT(IN) :: xx
117 INTEGER, DIMENSION(DIMX,TABLE%NDIM),INTENT(INOUT) :: IPOS
118 my_real, DIMENSION(DIMX) ,INTENT(INOUT) :: yy
119 my_real, DIMENSION(DIMX) ,INTENT(INOUT) :: dydx
120 LOGICAL, OPTIONAL, INTENT(IN) :: OPT_EXTRAPOLATE
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 LOGICAL :: NEED_TO_COMPUTE
125 INTEGER I,J,K,M,N,I1,I2,J1,J2,K1,K2,L1,L2,NDIM
126 INTEGER :: NINDX_1,NINDX_2
127 INTEGER, DIMENSION(NEL) :: INDX_1,INDX_2
128 INTEGER, DIMENSION(4) :: LDIM
129 my_real :: dx,dy,alpha,alphai,beta,betai,gamma,gammai,delta,deltai
130 my_real, DIMENSION(NEL,4) :: fac
131 LOGICAL DO_EXTRAPOLATION
132C-----------------------------------------------
133C Source Lines
134C-----------------------------------------------
135 do_extrapolation = .true.
136 IF(PRESENT(opt_extrapolate)) THEN
137 do_extrapolation = opt_extrapolate
138 ENDIF
139
140 ndim = table%NDIM
141 IF (SIZE(xx,2) < ndim ) THEN
142 CALL ancmsg(msgid=36,anmode=aninfo,c1='TABLE INTERPOLATION')
143 CALL arret(2)
144 END IF
145
146 DO k=1,ndim
147 ldim(k) = SIZE(table%X(k)%VALUES)
148 END DO
149
150 DO k=1,ndim
151 ipos(1:nel,k) = max(ipos(1:nel,k),1)
152 nindx_1 = 0
153 nindx_2 = 0
154#include "vectorize.inc"
155 DO i=1,nel
156 m = ipos(i,k)
157 dx = table%X(k)%VALUES(m) - xx(i,k)
158 IF (dx >= zero)THEN
159 nindx_1 = nindx_1 + 1
160 indx_1(nindx_1) = i
161 ELSE
162 nindx_2 = nindx_2 + 1
163 indx_2(nindx_2) = i
164 ENDIF
165 ENDDO
166
167 DO j=1,nindx_1
168 i = indx_1(j)
169 m = ipos(i,k)
170 need_to_compute = .true.
171 DO WHILE (need_to_compute )
172 dx = table%X(k)%VALUES(m) - xx(i,k)
173 IF (dx < zero .OR. m <= 1 ) THEN
174 ipos(i,k) = max(m,1)
175 need_to_compute = .false.
176 ELSE
177 m=m-1
178 ENDIF
179 ENDDO
180 ENDDO
181
182 DO j=1,nindx_2
183 i = indx_2(j)
184 m = ipos(i,k)
185 need_to_compute = .true.
186 DO WHILE (need_to_compute )
187 dx = table%X(k)%VALUES(m) - xx(i,k)
188 IF (dx >= zero .OR. m == ldim(k)) THEN
189 ipos(i,k) = m-1
190 need_to_compute = .false.
191 ELSE
192 m=m+1
193 ENDIF
194 ENDDO
195 ENDDO
196 ENDDO ! K=1,NDIM
197
198 DO k=1,ndim
199#include "vectorize.inc"
200 DO i=1,nel
201 n = ipos(i,k)
202 fac(i,k) = (table%X(k)%VALUES(n+1) - xx(i,k)) / (table%X(k)%VALUES(n+1) - table%X(k)%VALUES(n))
203 END DO
204 END DO
205
206 IF(.NOT. do_extrapolation)THEN
207 DO k=1,ndim
208#include "vectorize.inc"
209 DO i=1,nel
210 n = ipos(i,k)
211 fac(i,k) = min(one,max(fac(i,k),zero))
212 END DO
213 END DO
214 ENDIF
215c----------------------------------------------
216
217 SELECT CASE(ndim)
218
219 CASE(4)
220#include "vectorize.inc"
221 DO i=1,nel
222 i1 = ipos(i,1)
223 i2 = i1 + 1
224 j1 = ipos(i,2)
225 j2 = j1 + 1
226 k1 = ipos(i,3)
227 k2 = k1 + 1
228 l1 = ipos(i,4)
229 l2 = l1 + 1
230 alpha = fac(i,1)
231 beta = fac(i,2)
232 gamma = fac(i,3)
233 delta = fac(i,4)
234 alphai = one - alpha
235 betai = one - beta
236 gammai = one - gamma
237 deltai = one - delta
238 yy(i) =
239 . delta* (gamma*(beta * (alpha * table%Y4D(i1,j1,k1,l1)
240 . + alphai * table%Y4D(i2,j1,k1,l1))
241 . + betai* (alpha * table%Y4D(i1,j2,k1,l1)
242 . + alphai * table%Y4D(i2,j2,k1,l1)) )
243 . +gammai*( beta* (alpha * table%Y4D(i1,j1,k2,l1)
244 . + alphai * table%Y4D(i2,j1,k2,l1))
245 . + betai* (alpha * table%Y4D(i1,j2,k2,l1)
246 . + alphai * table%Y4D(i2,j2,k2,l1))))
247
248 . + deltai*(gamma *(beta * (alpha * table%Y4D(i1,j1,k1,l2)
249 . + alphai * table%Y4D(i2,j1,k1,l2))
250 . + betai* (alpha * table%Y4D(i1,j2,k1,l2)
251 . + alphai * table%Y4D(i2,j2,k1,l2)))
252 . +gammai* (beta* (alpha * table%Y4D(i1,j1,k2,l2)
253 . + alphai * table%Y4D(i2,j1,k2,l2))
254 . + betai* (alpha * table%Y4D(i1,j2,k2,l2)
255 . + alphai * table%Y4D(i2,j2,k2,l2))))
256!
257 dy = delta * (gamma *(beta *(table%Y4D(i2,j1,k1,l1)-table%Y4D(i1,j1,k1,l1))
258 . + betai*(table%Y4D(i2,j2,k1,l1)-table%Y4D(i1,j2,k1,l1)))
259 . + gammai *(beta *(table%Y4D(i2,j1,k2,l1)-table%Y4D(i1,j1,k2,l1))
260 . + betai*(table%Y4D(i2,j2,k2,l1)-table%Y4D(i1,j2,k2,l1))))
261 . + deltai * (gamma *(beta *(table%Y4D(i2,j1,k1,l2)-table%Y4D(i1,j1,k1,l2))
262 . + betai*(table%Y4D(i2,j2,k1,l2)-table%Y4D(i1,j2,k1,l2)))
263 . + gammai *(beta *(table%Y4D(i2,j1,k2,l2)-table%Y4D(i1,j1,k2,l2))
264 . + betai*(table%Y4D(i2,j2,k2,l2)-table%Y4D(i1,j2,k2,l2))))
265 dx = table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1)
266 dydx(i) = dy / dx
267 END DO
268C-----
269 CASE(3)
270#include "vectorize.inc"
271 DO i=1,nel
272 i1 = ipos(i,1)
273 i2 = i1 + 1
274 j1 = ipos(i,2)
275 j2 = j1 + 1
276 k1 = ipos(i,3)
277 k2 = k1 + 1
278 alpha = fac(i,1)
279 beta = fac(i,2)
280 gamma = fac(i,3)
281 alphai = one - alpha
282 betai = one - beta
283 gammai = one - gamma
284 yy(i)=(gamma * (beta * (alpha*table%Y3D(i1,j1,k1) + alphai*table%Y3D(i2,j1,k1))
285 . + betai* (alpha*table%Y3D(i1,j2,k1) + alphai*table%Y3D(i2,j2,k1)) )
286 . + gammai * (beta * (alpha*table%Y3D(i1,j1,k2) + alphai*table%Y3D(i2,j1,k2))
287 . + betai* (alpha*table%Y3D(i1,j2,k2) + alphai*table%Y3D(i2,j2,k2))))
288
289 dy = gamma * ( beta*(table%Y3D(i2,j1,k1) - table%Y3D(i1,j1,k1))
290 . + betai*(table%Y3D(i2,j2,k1) - table%Y3D(i1,j2,k1)))
291 . + gammai * ( beta*(table%Y3D(i2,j1,k2) - table%Y3D(i1,j1,k2))
292 . + betai*(table%Y3D(i2,j2,k2) - table%Y3D(i1,j2,k2)))
293 dx = table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1)
294 .
295 dydx(i) = dy / dx
296 END DO
297
298 CASE(2)
299#include "vectorize.inc"
300 DO i=1,nel
301 i1 = ipos(i,1)
302 i2 = i1 + 1
303 j1 = ipos(i,2)
304 j2 = j1 + 1
305 alpha = fac(i,1)
306 beta = fac(i,2)
307 alphai = one - alpha
308 betai = one - beta
309 yy(i) = (beta * (alpha*table%Y2D(i1,j1) + alphai*table%Y2D(i2,j1))
310 . + betai * (alpha*table%Y2D(i1,j2) + alphai*table%Y2D(i2,j2)) )
311 dydx(i) = (beta *(table%Y2D(i2,j1) - table%Y2D(i1,j1))
312 . + betai *(table%Y2D(i2,j2) - table%Y2D(i1,j2)))
313 . / (table%X(1)%VALUES(i2)-table%X(1)%VALUES(i1))
314 END DO
315
316 CASE(1)
317#include "vectorize.inc"
318 DO i=1,nel
319 i1 = ipos(i,1)
320 i2 = i1 + 1
321 alpha = fac(i,1)
322 alphai = one - alpha
323 yy(i) = alpha*table%Y1D(i1) + alphai*table%Y1D(i2)
324 dydx(i) = (table%Y1D(i2) - table%Y1D(i1)) / (table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1))
325 END DO
326
327 END SELECT
328c-----------
329 RETURN
330 END SUBROUTINE table_mat_vinterp
331c-----------
332 END MODULE table_mat_vinterp_mod
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
table4d_mod
Definition table4d_mod.F:54
table_mat_vinterp_mod
Definition table_mat_vinterp.F:33
table_mat_vinterp_mod::table_mat_vinterp
subroutine table_mat_vinterp(table, dimx, nel, ipos, xx, yy, dydx)
Definition table_mat_vinterp.F:46
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
table4d_mod::table_4d_
Definition table4d_mod.F:62