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