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 ../starter/source/materials/tools/table_mat_vinterp.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_eos_compaction_tab ../starter/source/materials/eos/hm_read_eos_compaction_tab.F90
27!|| hm_read_mat133 ../starter/source/materials/mat/mat133/hm_read_mat133.F90
28!|| law133_upd ../starter/source/materials/mat/mat133/law133_upd.F90
29!|| law87_upd ../starter/source/materials/mat/mat087/law87_upd.F90
30!|| s6zinit3 ../starter/source/elements/solid/solide6z/s6zinit3.F90
31!|| sigeps70 ../starter/source/materials/mat/mat070/sigeps70.F
32!||====================================================================
33 MODULE table_mat_vinterp_mod
34 CONTAINS
35!||====================================================================
36!|| table_mat_vinterp ../starter/source/materials/tools/table_mat_vinterp.F
37!||--- called by ------------------------------------------------------
38!|| hm_read_eos_compaction_tab ../starter/source/materials/eos/hm_read_eos_compaction_tab.F90
39!|| hm_read_mat133 ../starter/source/materials/mat/mat133/hm_read_mat133.F90
40!|| law133_upd ../starter/source/materials/mat/mat133/law133_upd.F90
41!|| law87_upd ../starter/source/materials/mat/mat087/law87_upd.F90
42!|| sigeps70 ../starter/source/materials/mat/mat070/sigeps70.F
43!||--- uses -----------------------------------------------------
44!||====================================================================
45 SUBROUTINE table_mat_vinterp(TABLE,DIMX,NEL,IPOS,XX,YY,DYDX)
46C-----------------------------------------------
47 USE table4d_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 TYPE(table_4d_) ,INTENT(IN) :: TABLE
56 INTEGER ,INTENT(IN) :: DIMX
57 INTEGER ,INTENT(IN) :: NEL
58 my_real, DIMENSION(DIMX,TABLE%NDIM),INTENT(IN) :: xx
59 INTEGER, DIMENSION(DIMX,TABLE%NDIM),INTENT(INOUT) :: IPOS
60 my_real, DIMENSION(NEL) ,INTENT(INOUT) :: yy
61 my_real, DIMENSION(NEL) ,INTENT(INOUT) :: dydx
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 LOGICAL, DIMENSION(NEL) :: NEED_TO_COMPUTE
66 INTEGER I,J,K,M,N,I1,I2,J1,J2,K1,K2,L1,L2,NDIM
67 INTEGER :: MINDX_1,MINDX_2
68 INTEGER :: NINDX_1,NINDX_2
69 INTEGER, DIMENSION(NEL) :: INDX_1,INDX_2
70 INTEGER, DIMENSION(4) :: LDIM
71 my_real :: dx,dy,alpha,alphai,beta,betai,gamma,gammai,delta,deltai
72 my_real, DIMENSION(NEL,4) :: fac
73c=======================================================================
74 ndim = table%NDIM
75C-----
76 DO k=1,ndim
77 ldim(k) = SIZE(table%X(k)%VALUES)
78 END DO
79c
80 DO k=1,ndim
81 ipos(1:nel,k) = max(ipos(1:nel,k),1)
82 nindx_1 = 0
83 mindx_1 = 0
84 nindx_2 = 0
85 mindx_2 = ldim(k) + 1
86#include "vectorize.inc"
87 DO i=1,nel
88 m = ipos(i,k)
89 dx = table%X(k)%VALUES(m) - xx(i,k)
90 IF (dx >= zero)THEN
91 nindx_1 = nindx_1 + 1
92 indx_1(nindx_1) = i
93 mindx_1 = max(mindx_1,m)
94 ELSE
95 nindx_2 = nindx_2 + 1
96 indx_2(nindx_2) = i
97 mindx_2 = min(mindx_2,m)
98 ENDIF
99 ENDDO
100
101 need_to_compute(1:nindx_1) = .true.
102 DO n = mindx_1,1,-1
103#include "vectorize.inc"
104 DO j=1,nindx_1
105 IF(need_to_compute(j)) THEN
106 i = indx_1(j)
107 m = ipos(i,k)
108 dx = table%X(k)%VALUES(n) - xx(i,k)
109 IF (dx < zero .OR. n <= 1) THEN
110 ipos(i,k)=max(n,1)
111 need_to_compute(j) = .false.
112 ENDIF
113 ENDIF
114 ENDDO
115 ENDDO
116c
117 need_to_compute(1:nindx_2) = .true.
118c
119 DO n=mindx_2,ldim(k)
120#include "vectorize.inc"
121 DO j=1,nindx_2
122 IF (need_to_compute(j)) THEN
123 i = indx_2(j)
124 m = ipos(i,k)
125 dx = table%X(k)%VALUES(n) - xx(i,k)
126 IF (dx >= zero .OR. n == ldim(k)) THEN
127 ipos(i,k) = n-1
128 need_to_compute(j) = .false.
129 ENDIF
130 ENDIF
131 ENDDO
132 ENDDO
133
134 ENDDO ! K=1,NDIM
135c
136 DO k=1,ndim
137#include "vectorize.inc"
138 DO i=1,nel
139 n = ipos(i,k)
140 fac(i,k) = (table%X(k)%VALUES(n+1) - xx(i,k))
141 . / (table%X(k)%VALUES(n+1) - table%X(k)%VALUES(n))
142 END DO
143 END DO
144c----------------------------------------------
145 SELECT CASE(ndim)
146
147 CASE(4)
148C
149#include "vectorize.inc"
150 DO i=1,nel
151 i1 = ipos(i,1)
152 i2 = i1 + 1
153 j1 = ipos(i,2)
154 j2 = j1 + 1
155 k1 = ipos(i,3)
156 k2 = k1 + 1
157 l1 = ipos(i,4)
158 l2 = k1 + 1
159 alpha = fac(i,1)
160 beta = fac(i,2)
161 gamma = fac(i,3)
162 delta = fac(i,4)
163 alphai = one - alpha
164 betai = one - beta
165 gammai = one - gamma
166 deltai = one - delta
167c
168 yy(i) =
169 . delta* (gamma*(beta * (alpha * table%Y4D(i1,j1,k1,l1)
170 . + alphai * table%Y4D(i2,j1,k1,l1))
171 . + betai* (alpha * table%Y4D(i1,j2,k1,l1)
172 . + alphai * table%Y4D(i2,j2,k1,l1)) )
173
174 . +gammai*( beta* (alpha * table%Y4D(i1,j1,k2,l1)
175 . + alphai * table%Y4D(i2,j1,k2,l1))
176 . + betai* (alpha * table%Y4D(i1,j2,k2,l1)
177 . + alphai * table%Y4D(i2,j2,k2,l1))))
178 . +deltai*(gamma *( beta* (alpha * table%Y4D(i1,j1,k1,l1)
179 . +alphai * table%Y4D(i2,j1,k1,l1))
180 . + betai* (alpha * table%Y4D(i1,j2,k1,l1)
181 . + alphai * table%Y4D(i2,j2,k1,l1)))
182 . +gammai*(beta * (alpha * table%Y4D(i1,j1,k2,l1)
183 . + alphai * table%Y4D(i2,j1,k2,l1))
184 . + betai* (alpha * table%Y4D(i1,j2,k2,l1)
185 . + alphai * table%Y4D(i2,j2,k2,l1))))
186c
187 dy = delta * (gamma *(beta *(table%Y4D(i2,j1,k1,l1)-table%Y4D(i1,j1,k1,l1))
188 . + betai*(table%Y4D(i2,j2,k1,l1)-table%Y4D(i1,j2,k1,l1)))
189 . + gammai *(beta *(table%Y4D(i2,j1,k2,l1)-table%Y4D(i1,j1,k2,l1))
190 . + betai*(table%Y4D(i2,j2,k2,l1)-table%Y4D(i1,j2,k2,l1))))
191 . + deltai * (gamma *(beta *(table%Y4D(i2,j1,k1,l1)-table%Y4D(i1,j1,k1,l1))
192 . + betai*(table%Y4D(i2,j2,k1,l1)-table%Y4D(i1,j2,k1,l1)))
193 . + gammai *(beta *(table%Y4D(i2,j1,k2,l1)-table%Y4D(i1,j1,k2,l1))
194 . + betai*(table%Y4D(i2,j2,k2,l1)-table%Y4D(i1,j2,k2,l1))))
195 .
196 .
197 dx = table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1)
198 dydx(i) = dy / dx
199 END DO
200C-----
201 CASE(3)
202C
203#include "vectorize.inc"
204 DO i=1,nel
205 i1 = ipos(i,1)
206 i2 = i1 + 1
207 j1 = ipos(i,2)
208 j2 = j1 + 1
209 k1 = ipos(i,3)
210 k2 = k1 + 1
211 alpha = fac(i,1)
212 beta = fac(i,2)
213 gamma = fac(i,3)
214 alphai = one - alpha
215 betai = one - beta
216 gammai = one - gamma
217C
218 yy(i)=(gamma * (beta* (alpha*table%Y3D(i1,j1,k1) + alphai*table%Y3D(i2,j1,k1))
219 . + betai* (alpha*table%Y3D(i1,j2,k1) + alphai*table%Y3D(i2,j2,k1)) )
220 . + gammai * (beta* (alpha*table%Y3D(i1,j1,k2) + alphai*table%Y3D(i2,j1,k2))
221 . + betai* (alpha*table%Y3D(i1,j2,k2) + alphai*table%Y3D(i2,j2,k2))))
222c
223 dy = gamma * ( beta*(table%Y3D(i2,j1,k1) - table%Y3D(i1,j1,k1))
224 . + betai*(table%Y3D(i2,j2,k1) - table%Y3D(i1,j2,k1)))
225 . + gammai * ( beta*(table%Y3D(i2,j1,k2) - table%Y3D(i1,j1,k2))
226 . + betai*(table%Y3D(i2,j2,k2) - table%Y3D(i1,j2,k2)))
227 dx = table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1)
228 .
229 dydx(i) = dy / dx
230 END DO
231C-----
232 CASE(2)
233C
234#include "vectorize.inc"
235 DO i=1,nel
236 i1 = ipos(i,1)
237 i2 = i1 + 1
238 j1 = ipos(i,2)
239 j2 = j1 + 1
240 alpha = fac(i,1)
241 beta = fac(i,2)
242 alphai = one - alpha
243 betai = one - beta
244c
245 yy(i) = (beta * (alpha*table%Y2D(i1,j1) + alphai*table%Y2D(i2,j1))
246 . + betai * (alpha*table%Y2D(i1,j2) + alphai*table%Y2D(i2,j2)) )
247c
248 dydx(i) = (beta *(table%Y2D(i2,j1) - table%Y2D(i1,j1))
249 . + betai *(table%Y2D(i2,j2) - table%Y2D(i1,j2)))
250 . / (table%X(1)%VALUES(i2)-table%X(1)%VALUES(i1))
251 END DO
252C-----
253 CASE(1)
254c
255#include "vectorize.inc"
256 DO i=1,nel
257 i1 = ipos(i,1)
258 i2 = i1 + 1
259 alpha = fac(i,1)
260 alphai = one - alpha
261c
262 yy(i) = alpha*table%Y1D(i1) + alphai*table%Y1D(i2)
263 dydx(i) = (table%Y1D(i2) - table%Y1D(i1))
264 . / (table%X(1)%VALUES(i2) - table%X(1)%VALUES(i1))
265 END DO
266C-----
267 END SELECT
268c-----------
269 RETURN
270 END SUBROUTINE table_mat_vinterp
271c-----------
272 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
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
table4d_mod::table_4d_
Definition table4d_mod.F:62