OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7cork3.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!|| i7cork3 ../engine/source/interfaces/int07/i7cork3.F
25!||--- called by ------------------------------------------------------
26!|| i10fku3 ../engine/source/interfaces/int10/i10ke3.F
27!|| i10ke3 ../engine/source/interfaces/int10/i10ke3.f
28!|| i7fku3 ../engine/source/interfaces/int07/i7ke3.F
29!|| i7ke3 ../engine/source/interfaces/int07/i7ke3.F
30!|| imp_i10mainf ../engine/source/interfaces/int10/i10ke3.F
31!|| imp_i7mainf ../engine/source/interfaces/int07/i7ke3.F
32!||--- uses -----------------------------------------------------
33!|| tri7box ../engine/share/modules/tri7box.F
34!||====================================================================
35 SUBROUTINE i7cork3(JLT ,X ,IRECT ,NSV ,CAND_E ,
36 1 CAND_N ,STF ,STFN ,X1 ,X2 ,
37 2 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
38 3 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
39 4 XI ,YI ,ZI ,STIF ,IX1 ,
40 5 IX2 ,IX3 ,IX4 ,NSVG ,IGAP ,
41 6 GAP ,GAP_S ,GAP_M ,GAPV ,MS ,
42 7 VXI ,VYI ,VZI ,MSI ,V ,
43 8 IGSTI ,KMIN ,KMAX ,GAPMAX,GAPMIN ,
44 9 NIN ,ITY ,NSN )
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE tri7box
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
64 . JLT,IDT, NOINT,IGAP , IGSTI,NIN,ITY,NSN
65 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
66 . NSVG(MVSIZ)
67 my_real
68 . GAP, X(3,*), STF(*), STFN(*),GAP_S(*),GAP_M(*),
69 . MS(*), V(3,*)
70 my_real
71 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
72 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
73 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
74 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
75 . gapv(mvsiz),
76 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
77 . kmin, kmax, gapmax,gapmin
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I ,J ,IL, L, NN, IG,JFT,NI,IX
82C-----------------------------------------------
83C
84 IF(IGAP==0)then
85 DO i=1,jlt
86 gapv(i)=gap
87 ENDDO
88 ELSE
89 DO i=1,jlt
90 IF(cand_n(i)<=nsn) THEN
91 gapv(i)=gap_s(cand_n(i))+gap_m(cand_e(i))
92 ELSE
93 gapv(i)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
94 ENDIF
95 gapv(i)=min(gapv(i),gapmax)
96 gapv(i)=max(gapmin,gapv(i))
97 ENDDO
98 ENDIF
99C
100 IF(ity==7) THEN
101 DO i=1,jlt
102 ni = cand_n(i)
103 l = cand_e(i)
104 IF(ni<=nsn)THEN
105 ig = nsv(ni)
106 nsvg(i) = ig
107C KINI(I) = KINET(IG)
108 xi(i) = x(1,ig)
109 yi(i) = x(2,ig)
110 zi(i) = x(3,ig)
111 vxi(i) = v(1,ig)
112 vyi(i) = v(2,ig)
113 vzi(i) = v(3,ig)
114 msi(i)= ms(ig)
115 ELSE
116 nn = ni - nsn
117 nsvg(i) = -nn
118C qz KINI(I) = KINFI(NIN)%P(NN)
119 xi(i) = xfi(nin)%P(1,nn)
120 yi(i) = xfi(nin)%P(2,nn)
121 zi(i) = xfi(nin)%P(3,nn)
122 vxi(i)= vfi(nin)%P(1,nn)
123 vyi(i)= vfi(nin)%P(2,nn)
124 vzi(i)= vfi(nin)%P(3,nn)
125 msi(i)= msfi(nin)%P(nn)
126C
127 END IF
128C
129 ix=irect(1,l)
130 ix1(i)=ix
131 x1(i)=x(1,ix)
132 y1(i)=x(2,ix)
133 z1(i)=x(3,ix)
134C
135 ix=irect(2,l)
136 ix2(i)=ix
137 x2(i)=x(1,ix)
138 y2(i)=x(2,ix)
139 z2(i)=x(3,ix)
140C
141 ix=irect(3,l)
142 ix3(i)=ix
143 x3(i)=x(1,ix)
144 y3(i)=x(2,ix)
145 z3(i)=x(3,ix)
146C
147 ix=irect(4,l)
148 ix4(i)=ix
149 x4(i)=x(1,ix)
150 y4(i)=x(2,ix)
151 z4(i)=x(3,ix)
152C
153 END DO
154 IF(igsti<=1)THEN
155 DO i=1,jlt
156 l = cand_e(i)
157 ni = cand_n(i)
158 IF(ni<=nsn)THEN
159 stif(i)=stf(l)*abs(stfn(ni))
160 ELSE
161 nn = ni - nsn
162 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
163 END IF
164 ENDDO
165 ELSEIF(igsti==2)THEN
166 DO i=1,jlt
167 l = cand_e(i)
168 ni = cand_n(i)
169 IF(ni<=nsn)THEN
170 stif(i)=abs(stfn(ni))
171 ELSE
172 nn = ni - nsn
173 stif(i)=abs(stifi(nin)%P(nn))
174 END IF
175 stif(i)=half*(stf(l)+stif(i))
176 stif(i)=max(kmin,min(stif(i),kmax))
177 ENDDO
178 ELSEIF(igsti==3)THEN
179 DO i=1,jlt
180 l = cand_e(i)
181 ni = cand_n(i)
182 IF(ni<=nsn)THEN
183 stif(i)=abs(stfn(ni))
184 ELSE
185 nn = ni - nsn
186 stif(i)=abs(stifi(nin)%P(nn))
187 END IF
188 stif(i)=max(stf(l),stif(i))
189 stif(i)=max(kmin,min(stif(i),kmax))
190 ENDDO
191 ELSEIF(igsti==4)THEN
192 DO i=1,jlt
193 l = cand_e(i)
194 ni = cand_n(i)
195 IF(ni<=nsn)THEN
196 stif(i)=abs(stfn(ni))
197 ELSE
198 nn = ni - nsn
199 stif(i)=abs(stifi(nin)%P(nn))
200 END IF
201 stif(i)=min(stf(l),stif(i))
202 stif(i)=max(kmin,min(stif(i),kmax))
203 ENDDO
204 ELSEIF(igsti==5)THEN
205 DO i=1,jlt
206 l = cand_e(i)
207 ni = cand_n(i)
208 IF(ni<=nsn)THEN
209 stif(i)=abs(stfn(ni))
210 ELSE
211 nn = ni - nsn
212 stif(i)=abs(stifi(nin)%P(nn))
213 END IF
214 stif(i)=stf(l)*stif(i)/
215 . max(em30,(stf(l)+stif(i)))
216 stif(i)=max(kmin,min(stif(i),kmax))
217 ENDDO
218 ENDIF
219 ELSE
220C type7 KINET en -
221 DO i=1,jlt
222 ni = cand_n(i)
223 l = cand_e(i)
224 IF(ni<=nsn)THEN
225 ig = nsv(ni)
226 nsvg(i) = ig
227C KINI(I) = KINET(IG)
228 xi(i) = x(1,ig)
229 yi(i) = x(2,ig)
230 zi(i) = x(3,ig)
231 vxi(i) = v(1,ig)
232 vyi(i) = v(2,ig)
233 vzi(i) = v(3,ig)
234 msi(i)= ms(ig)
235 stif(i)=stf(l)*abs(stfn(ni))
236 ELSE
237 nn = ni - nsn
238 nsvg(i) = -nn
239C KINI(I) = KINFI(NIN)%P(NN)
240 xi(i) = xfi(nin)%P(1,nn)
241 yi(i) = xfi(nin)%P(2,nn)
242 zi(i) = xfi(nin)%P(3,nn)
243 vxi(i)= vfi(nin)%P(1,nn)
244 vyi(i)= vfi(nin)%P(2,nn)
245 vzi(i)= vfi(nin)%P(3,nn)
246 msi(i)= msfi(nin)%P(nn)
247 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
248C
249 END IF
250C
251 ix=irect(1,l)
252 ix1(i)=ix
253 x1(i)=x(1,ix)
254 y1(i)=x(2,ix)
255 z1(i)=x(3,ix)
256C
257 ix=irect(2,l)
258 ix2(i)=ix
259 x2(i)=x(1,ix)
260 y2(i)=x(2,ix)
261 z2(i)=x(3,ix)
262C
263 ix=irect(3,l)
264 ix3(i)=ix
265 x3(i)=x(1,ix)
266 y3(i)=x(2,ix)
267 z3(i)=x(3,ix)
268C
269 ix=irect(4,l)
270 ix4(i)=ix
271 x4(i)=x(1,ix)
272 y4(i)=x(2,ix)
273 z4(i)=x(3,ix)
274C
275 END DO
276 END IF
277C
278 RETURN
279 END
280!||====================================================================
281!|| i7corp3 ../engine/source/interfaces/int07/i7cork3.F
282!||--- called by ------------------------------------------------------
283!|| i7forcf3 ../engine/source/interfaces/int07/i7ke3.F
284!||--- uses -----------------------------------------------------
285!|| imp_intm ../engine/share/modules/imp_intm.F
286!|| tri7box ../engine/share/modules/tri7box.F
287!||====================================================================
288 SUBROUTINE i7corp3(JLT ,X ,IRECT ,CAND_E ,CAND_N ,
289 1 STIF ,H1 ,H2 ,H3 ,H4 ,
290 2 N1 ,N2 ,N3 ,IX1 ,IX2 ,
291 3 IX3 ,IX4 ,NSVG ,VXI ,VYI ,
292 4 VZI ,MSI ,DXI ,DYI ,DZI ,
293 5 NSN ,NIN ,JLT_NEW ,LREM )
294C-----------------------------------------------
295C M o d u l e s
296C-----------------------------------------------
297 USE tri7box
298 USE imp_intm
299C-----------------------------------------------
300C I m p l i c i t T y p e s
301C-----------------------------------------------
302#include "implicit_f.inc"
303C-----------------------------------------------
304C G l o b a l P a r a m e t e r s
305C-----------------------------------------------
306#include "mvsiz_p.inc"
307C-----------------------------------------------
308C D u m m y A r g u m e n t s
309C-----------------------------------------------
310 INTEGER IRECT(4,*), CAND_E(*), CAND_N(*),
311 . jlt,jlt_new,nin,nsn,lrem
312 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
313 . NSVG(MVSIZ)
314C REAL
315C REAL
316 my_real
317 . VXI(MVSIZ), VYI(MVSIZ), VZI(MVSIZ), MSI(MVSIZ),
318 . X(3,*), STIF(*),N1(MVSIZ), N2(MVSIZ), N3(MVSIZ),
319 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
320 . DXI(MVSIZ),DYI(MVSIZ),DZI(MVSIZ)
321C-----------------------------------------------
322C L o c a l V a r i a b l e s
323C-----------------------------------------------
324 INTEGER I ,J ,NI, L, NN, NS ,NE
325C-----------------------------------------------
326C
327C
328 DO i=1,jlt
329 ni = cand_n(i)
330 l = cand_e(i)
331 IF(ni>nsn)THEN
332 nn = ni - nsn
333 jlt_new = jlt_new + 1
334 vxi(jlt_new)= vfi(nin)%P(1,nn)
335 vyi(jlt_new)= vfi(nin)%P(2,nn)
336 vzi(jlt_new)= vfi(nin)%P(3,nn)
337 msi(jlt_new)= msfi(nin)%P(nn)
338 ix1(jlt_new) = irect(1,l)
339 ix2(jlt_new) = irect(2,l)
340 ix3(jlt_new) = irect(3,l)
341 ix4(jlt_new) = irect(4,l)
342 ns=ind_int(nin)%P(nn)
343 ne=shf_int(nin)+jlt_new+lrem
344 nsvg(jlt_new) = ns
345 h1(jlt_new) = h_e(1,ne)
346 h2(jlt_new) = h_e(2,ne)
347 h3(jlt_new) = h_e(3,ne)
348 h4(jlt_new) = h_e(4,ne)
349 stif(jlt_new)=stifs(ne)
350 n1(jlt_new)=n_e(1,ne)
351 n2(jlt_new)=n_e(2,ne)
352 n3(jlt_new)=n_e(3,ne)
353C----------displacement
354 dxi(jlt_new)=dfi(1,ns)
355 dyi(jlt_new)=dfi(2,ns)
356 dzi(jlt_new)=dfi(3,ns)
357C
358 END IF
359C
360 END DO
361C
362 RETURN
363 END
364!||====================================================================
365!|| i7corkp3 ../engine/source/interfaces/int07/i7cork3.F
366!||--- called by ------------------------------------------------------
367!|| i10fku3 ../engine/source/interfaces/int10/i10ke3.f
368!|| i7fku3 ../engine/source/interfaces/int07/i7ke3.F
369!||--- uses -----------------------------------------------------
370!|| imp_intm ../engine/share/modules/imp_intm.F
371!||====================================================================
372 SUBROUTINE i7corkp3(
373 1 JLT ,XI ,YI ,ZI ,D ,
374 2 DXI ,DYI ,DZI ,NSVG ,NIN ,
375 3 IUPD )
376C-----------------------------------------------
377C M o d u l e s
378C-----------------------------------------------
379 USE imp_intm
380C-----------------------------------------------
381C I m p l i c i t T y p e s
382C-----------------------------------------------
383#include "implicit_f.inc"
384C-----------------------------------------------
385C G l o b a l P a r a m e t e r s
386C-----------------------------------------------
387#include "mvsiz_p.inc"
388C-----------------------------------------------
389C D u m m y A r g u m e n t s
390C-----------------------------------------------
391 INTEGER
392 . JLT,NIN,IUPD,NSVG(MVSIZ)
393C REAL
394C REAL
395 my_real
396 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
397 . dxi(mvsiz),dyi(mvsiz),dzi(mvsiz),d(3,*)
398C-----------------------------------------------
399C L o c a l V a r i a b l e s
400C-----------------------------------------------
401 INTEGER I ,J ,NI, L, NN, NS ,NE
402C-----------------------------------------------
403C
404C
405 DO I=1,jlt
406 ni = nsvg(i)
407 IF(ni<0)THEN
408 nn = -ni
409 ns=ind_int(nin)%P(nn)
410C----------displacement
411 dxi(i)=dfi(1,ns)
412 dyi(i)=dfi(2,ns)
413 dzi(i)=dfi(3,ns)
414 ELSE
415 dxi(i) = d(1,ni)
416 dyi(i) = d(2,ni)
417 dzi(i) = d(3,ni)
418 END IF
419C----------update
420 IF(iupd>0.AND.ni<0)THEN
421 xi(i) = xi(i) + dxi(i)
422 yi(i) = yi(2) + dyi(i)
423 zi(i) = zi(3) + dzi(i)
424 END IF
425C
426 END DO
427C
428 RETURN
429 END
subroutine i10fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iupd)
Definition i10ke3.F:293
subroutine i10ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem)
Definition i10ke3.F:41
subroutine i7corp3(jlt, x, irect, cand_e, cand_n, stif, h1, h2, h3, h4, n1, n2, n3, ix1, ix2, ix3, ix4, nsvg, vxi, vyi, vzi, msi, dxi, dyi, dzi, nsn, nin, jlt_new, lrem)
Definition i7cork3.F:294
subroutine i7corkp3(jlt, xi, yi, zi, d, dxi, dyi, dzi, nsvg, nin, iupd)
Definition i7cork3.F:376
subroutine i7cork3(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsvg, igap, gap, gap_s, gap_m, gapv, ms, vxi, vyi, vzi, msi, v, igsti, kmin, kmax, gapmax, gapmin, nin, ity, nsn)
Definition i7cork3.F:45
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, dimension(:), allocatable shf_int
Definition imp_intm.F:136
type(int_pointer2), dimension(:), allocatable ind_int
Definition imp_intm.F:133
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459