OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
table2d_vinterp_log.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine table2d_vinterp_log (table, ismooth, dimx, nel, ipos, xx, yy, dydx1, dydx2)

Function/Subroutine Documentation

◆ table2d_vinterp_log()

subroutine table2d_vinterp_log ( type(ttable) table,
integer, intent(in) ismooth,
integer, intent(in) dimx,
integer, intent(in) nel,
integer, dimension(dimx,table%ndim) ipos,
dimension(dimx,table%ndim) xx,
dimension(nel) yy,
dimension(nel) dydx1,
dimension(nel) dydx2 )

Definition at line 51 of file table2d_vinterp_log.F.

52C-----------------------------------------------
53 USE table_mod
54 USE message_mod
55c-----------------------------------------------
56c vectorized 2D table interpolation
57c dependency on second variable may be interpolated using following algorithms :
58c ISMOOTH = 1 => linear interpolation
59c ISMOOTH = 2 => logarythmic interpolation base 10
60c ISMOOTH = 3 => logarythmic interpolation base n
61c OUTPUT :
62c YY interpolated function value
63c DYDX1 partial derivative vs 1st independent variable
64c DYDX2 partial derivative vs 2nd independent variable
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "com01_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE(TTABLE) :: TABLE
77 INTEGER ,INTENT(IN) :: ISMOOTH
78 INTEGER ,INTENT(IN) :: NEL
79 INTEGER ,INTENT(IN) :: DIMX
80 INTEGER ,DIMENSION(DIMX,TABLE%NDIM) :: IPOS
81 my_real ,DIMENSION(DIMX,TABLE%NDIM) :: xx
82 my_real ,DIMENSION(NEL) :: yy, dydx1, dydx2
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER NXK(2), IB(2,2,NEL)
87 INTEGER :: I,I1,I2,J1,J2,K,N,M,L,IN,IM,IL,N1,IL1,IL2,NDIM
88 my_real :: dx1,dx2,ya1,ya2,yb1,yb2,x1_1,x1_2,x2_1,x2_2,xx2,
89 . x1,x2,y1,y2,r1,r2,unr1,unr2
90 TYPE(TTABLE_XY) ,POINTER :: TY
91 TYPE(TTABLE_XY), DIMENSION(:) ,POINTER :: TX
92C=======================================================================
93 ndim = table%NDIM
94 IF (SIZE(xx,2) < ndim .or. ndim > 2) THEN
95 CALL ancmsg(msgid=36,anmode=aninfo,c1='TABLE INTERPOLATION')
96 CALL arret(2)
97 END IF
98c-----
99 IF (ncycle == 0) THEN
100 ipos(1:dimx,1:ndim) = 1
101 END IF
102c-----
103 tx => table%X
104 ty => table%Y
105c--------------------------------------
106 DO k=1,ndim
107 nxk(k) = SIZE(tx(k)%VALUES)
108 DO i=1,nel
109 ipos(i,k) = max(ipos(i,k),1)
110 ipos(i,k) = min(ipos(i,k),nxk(k))
111 m = ipos(i,k)
112 dx2 = tx(k)%VALUES(m) - xx(i,k)
113 IF (dx2 >= zero)THEN
114 DO n = m-1,1,-1
115 dx2 = tx(k)%VALUES(n) - xx(i,k)
116 IF (dx2 < zero .OR. n <=1)THEN
117 ipos(i,k) = max(n,1)
118 EXIT
119 ENDIF
120 END DO
121 ELSE
122 DO n = m+1,nxk(k)
123 dx2 = tx(k)%VALUES(n) - xx(i,k)
124 IF (dx2 >= zero .OR. n == nxk(k)) THEN
125 ipos(i,k) = n-1
126 EXIT
127 ENDIF
128 END DO
129 END IF
130 END DO
131 END DO
132c---------------------
133 SELECT CASE(ndim)
134c---------------------
135 CASE(1)
136c-----
137 DO i=1,nel
138 n = ipos(i,1)
139 x1 = tx(1)%VALUES(n)
140 x2 = tx(1)%VALUES(n+1)
141 y1 = ty%VALUES(n)
142 y2 = ty%VALUES(n+1)
143 r1 = (x2 - xx(i,1)) / (x2 - x1)
144 unr1 = one - r1
145 yy(i) = r1*y1 + unr1*y2
146 dydx1(i)= (y2 - y1) / (x2 - x1)
147 END DO
148c-----
149 CASE(2)
150c-----
151 n1 = nxk(1)
152 DO i=1,nel
153 il1 = ipos(i,1)
154 il2 = ipos(i,2)
155 DO m=0,1
156 im = n1*(il2 - 1 + m)
157 ib(1,m+1,i) = im + il1
158 ib(2,m+1,i) = im + il1 + 1
159 END DO
160 END DO
161c
162 IF (ismooth == 1) THEN ! linear interpolation
163c
164 DO i=1,nel
165 i1 = ipos(i,1)
166 i2 = i1 + 1
167 j1 = ipos(i,2)
168 j2 = j1 + 1
169 ya1 = ty%VALUES(ib(1,1,i))
170 yb1 = ty%VALUES(ib(2,1,i))
171 ya2 = ty%VALUES(ib(1,2,i))
172 yb2 = ty%VALUES(ib(2,2,i))
173 x1_1 = tx(1)%VALUES(i1)
174 x1_2 = tx(1)%VALUES(i2)
175 x2_1 = tx(2)%VALUES(j1)
176 x2_2 = tx(2)%VALUES(j2)
177c
178 r1 = (x1_2 - xx(i,1)) / (x1_2 - x1_1)
179 r2 = (x2_2 - xx(i,2)) / (x2_2 - x2_1)
180 unr1 = one - r1
181 unr2 = one - r2
182c
183 y1 = r1*ya1 + unr1*yb1
184 y2 = r1*ya2 + unr1*yb2
185c
186 yy(i) = r2*y1 + unr2*y2
187 dydx1(i) = (r2*(yb1 - ya1) + unr2*(yb2 - ya2)) / (x1_2 - x1_1)
188 dydx2(i) = (y2 - y1) / (x2_2 - x2_1)
189 END DO
190c
191 ELSE IF (ismooth == 2) THEN ! logarythmic interpolation base 10
192c
193 DO i=1,nel
194 i1 = ipos(i,1)
195 i2 = i1 + 1
196 j1 = ipos(i,2)
197 j2 = j1 + 1
198 ya1 = ty%VALUES(ib(1,1,i))
199 yb1 = ty%VALUES(ib(2,1,i))
200 ya2 = ty%VALUES(ib(1,2,i))
201 yb2 = ty%VALUES(ib(2,2,i))
202 x1_1 = tx(1)%VALUES(i1)
203 x1_2 = tx(1)%VALUES(i2)
204 x2_1 = tx(2)%VALUES(j1)
205 x2_2 = tx(2)%VALUES(j2)
206 xx2 = max(xx(i,2), em10)
207 x2_1 = max(x2_1, em10)
208c
209 r1 = (x1_2 - xx(i,1)) / (x1_2 - x1_1)
210 r2 = (log10(x2_2) - log10(xx2)) / (log10(x2_2) - log10(x2_1))
211 unr1 = one - r1
212 unr2 = one - r2
213c
214 y1 = r1*ya1 + unr1*yb1
215 y2 = r1*ya2 + unr1*yb2
216c
217 yy(i) = r2*y1 + unr2*y2
218 dydx1(i) = (r2*(yb1 - ya1) + unr2*(yb2 - ya2)) / (x1_2 - x1_1)
219 dydx2(i) = (y2 - y1) / (x2_2 - x2_1)
220 END DO
221c
222 ELSE IF (ismooth == 3) THEN ! logarythmic interpolation base n
223c
224 DO i=1,nel
225 i1 = ipos(i,1)
226 i2 = i1 + 1
227 j1 = ipos(i,2)
228 j2 = j1 + 1
229 ya1 = ty%VALUES(ib(1,1,i))
230 yb1 = ty%VALUES(ib(2,1,i))
231 ya2 = ty%VALUES(ib(1,2,i))
232 yb2 = ty%VALUES(ib(2,2,i))
233 x1_1 = tx(1)%VALUES(i1)
234 x1_2 = tx(1)%VALUES(i2)
235 x2_1 = tx(2)%VALUES(j1)
236 x2_2 = tx(2)%VALUES(j2)
237 xx2 = max(xx(i,2), em10)
238 x2_1 = max(x2_1, em10)
239c
240 r1 = (x1_2 - xx(i,1)) / (x1_2 - x1_1)
241 r2 = (log(x2_2) - log(xx2)) / (log(x2_2) - log(x2_1))
242 unr1 = one - r1
243 unr2 = one - r2
244c
245 y1 = r1*ya1 + unr1*yb1
246 y2 = r1*ya2 + unr1*yb2
247c
248 yy(i) = r2*y1 + unr2*y2
249 dydx1(i) = (r2*(yb1 - ya1) + unr2*(yb2 - ya2)) / (x1_2 - x1_1)
250 dydx2(i) = (y2 - y1) / (x2_2 - x2_1)
251 END DO
252c
253 END IF
254c-----------
255 END SELECT
256c-----------
257 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
table_mod
Definition table_mod.F:112
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