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