OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24cork3.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!|| i24cork3 ../engine/source/interfaces/int24/i24cork3.F
25!||--- uses -----------------------------------------------------
26!|| tri7box ../engine/share/modules/tri7box.F
27!||====================================================================
28 SUBROUTINE i24cork3(
29 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
30 2 CAND_N ,STF ,STFN ,STIF ,
31 3 XX0 ,YY0 ,ZZ0 ,VX ,VY ,
32 5 VZ ,XI ,YI ,ZI ,VXI ,
33 7 VYI ,VZI ,IXX ,NSVG ,NVOISIN,
34 9 MS ,MSI ,NSN ,V ,
35 A KINI ,ITY ,NIN ,IGSTI ,KMIN ,
36 B KMAX ,GAP_S ,GAPS ,ITRIV )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE tri7box
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
53 . JLT,IDT, NOINT ,NDDIM, NSN, ITY, NIN, IGSTI,
54 . NVOISIN(8,*), KINI(*)
55 INTEGER IXX(MVSIZ,13), NSVG(MVSIZ), ITRIV(4,MVSIZ)
56C REAL
57 my_real
58 . X(3,*), STF(*), STFN(*),
59 . MS(*), V(3,*),GAPS(MVSIZ),GAP_S(*)
60C REAL
61 my_real
62 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
63 . xx0(mvsiz,17),yy0(mvsiz,17),zz0(mvsiz,17),
64 . vx(mvsiz,17),vy(mvsiz,17),vz(mvsiz,17),
65 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
66 . kmin, kmax
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI
71C-----------------------------------------------
72C
73C
74 DO I=1,jlt
75 ni = cand_n(i)
76 l = iabs(cand_e(i))
77 IF(ni<=nsn)THEN
78 ig = nsv(ni)
79 nsvg(i) = ig
80c KINI(I) = KINET(IG)
81 xi(i) = x(1,ig)
82 yi(i) = x(2,ig)
83 zi(i) = x(3,ig)
84 vxi(i) = v(1,ig)
85 vyi(i) = v(2,ig)
86 vzi(i) = v(3,ig)
87 msi(i)= ms(ig)
88 gaps(i) = gap_s(ni)
89 ELSE
90 nn = ni - nsn
91 nsvg(i) = -nn
92c KINI(I) = KINFI(NIN)%P(NN)
93 xi(i) = xfi(nin)%P(1,nn)
94 yi(i) = xfi(nin)%P(2,nn)
95 zi(i) = xfi(nin)%P(3,nn)
96 vxi(i)= vfi(nin)%P(1,nn)
97 vyi(i)= vfi(nin)%P(2,nn)
98 vzi(i)= vfi(nin)%P(3,nn)
99 msi(i)= msfi(nin)%P(nn)
100 gaps(i) = gapfi(nin)%P(nn)
101 END IF
102C
103 ix=irect(1,l)
104 ixx(i,1)=ix
105 xx0(i,1)=x(1,ix)
106 yy0(i,1)=x(2,ix)
107 zz0(i,1)=x(3,ix)
108 vx(i,1)=v(1,ix)
109 vy(i,1)=v(2,ix)
110 vz(i,1)=v(3,ix)
111C
112 ix=irect(2,l)
113 ixx(i,2)=ix
114 xx0(i,2)=x(1,ix)
115 yy0(i,2)=x(2,ix)
116 zz0(i,2)=x(3,ix)
117 vx(i,2)=v(1,ix)
118 vy(i,2)=v(2,ix)
119 vz(i,2)=v(3,ix)
120C
121 ix=irect(3,l)
122 ixx(i,3)=ix
123 xx0(i,3)=x(1,ix)
124 yy0(i,3)=x(2,ix)
125 zz0(i,3)=x(3,ix)
126 vx(i,3)=v(1,ix)
127 vy(i,3)=v(2,ix)
128 vz(i,3)=v(3,ix)
129C
130 ix=irect(4,l)
131 ixx(i,4)=ix
132 xx0(i,4)=x(1,ix)
133 yy0(i,4)=x(2,ix)
134 zz0(i,4)=x(3,ix)
135 vx(i,4)=v(1,ix)
136 vy(i,4)=v(2,ix)
137 vz(i,4)=v(3,ix)
138C
139 IF(ixx(i,3) /= ixx(i,4))THEN
140 xx0(i,5) = fourth*(xx0(i,1)+xx0(i,2)+xx0(i,3)+xx0(i,4))
141 yy0(i,5) = fourth*(yy0(i,1)+yy0(i,2)+yy0(i,3)+yy0(i,4))
142 zz0(i,5) = fourth*(zz0(i,1)+zz0(i,2)+zz0(i,3)+zz0(i,4))
143 vx(i,5) = fourth*(vx(i,1)+vx(i,2)+vx(i,3)+vx(i,4))
144 vy(i,5) = fourth*(vy(i,1)+vy(i,2)+vy(i,3)+vy(i,4))
145 vz(i,5) = fourth*(vz(i,1)+vz(i,2)+vz(i,3)+vz(i,4))
146 ELSE
147 xx0(i,5) = xx0(i,3)
148 yy0(i,5) = yy0(i,3)
149 zz0(i,5) = zz0(i,3)
150 vx(i,5) = vx(i,3)
151 vy(i,5) = vy(i,3)
152 vz(i,5) = vz(i,3)
153 ENDIF
154
155 ix=iabs(nvoisin(1,l))
156 ixx(i,6)=ix
157 IF(ix /= 0)THEN
158 xx0(i,6)=x(1,ix)
159 yy0(i,6)=x(2,ix)
160 zz0(i,6)=x(3,ix)
161 vx(i,6) =v(1,ix)
162 vy(i,6) =v(2,ix)
163 vz(i,6) =v(3,ix)
164 ELSE
165 xx0(i,6)=xx0(i,1)
166 yy0(i,6)=yy0(i,1)
167 zz0(i,6)=zz0(i,1)
168 vx(i,6) =vx(i,1)
169 vy(i,6) =vy(i,1)
170 vz(i,6) =vz(i,1)
171 ENDIF
172
173 IF(nvoisin(2,l)/=0)ix=iabs(nvoisin(2,l))
174 ixx(i,7)=ix
175 IF(ix /= 0)THEN
176 xx0(i,7)=x(1,ix)
177 yy0(i,7)=x(2,ix)
178 zz0(i,7)=x(3,ix)
179 vx(i,7)=v(1,ix)
180 vy(i,7)=v(2,ix)
181 vz(i,7)=v(3,ix)
182 ELSE
183 xx0(i,7)=xx0(i,2)
184 yy0(i,7)=yy0(i,2)
185 zz0(i,7)=zz0(i,2)
186 vx(i,7) =vx(i,2)
187 vy(i,7) =vy(i,2)
188 vz(i,7) =vz(i,2)
189 ENDIF
190
191 IF(nvoisin(1,l)<0)THEN
192 IF(nvoisin(2,l)<0)THEN
193 itriv(1,i)=4
194 ELSE
195 itriv(1,i)=2
196 ENDIF
197 ELSEIF(nvoisin(2,l)<0)THEN
198 itriv(1,i)=3
199 ELSE
200 itriv(1,i)=1
201 ENDIF
202
203 ix=iabs(nvoisin(3,l))
204 ixx(i,8)=ix
205 IF(ix /= 0)THEN
206 xx0(i,8)=x(1,ix)
207 yy0(i,8)=x(2,ix)
208 zz0(i,8)=x(3,ix)
209 vx(i,8)=v(1,ix)
210 vy(i,8)=v(2,ix)
211 vz(i,8)=v(3,ix)
212 ELSE
213 xx0(i,8)=xx0(i,2)
214 yy0(i,8)=yy0(i,2)
215 zz0(i,8)=zz0(i,2)
216 vx(i,8) =vx(i,2)
217 vy(i,8) =vy(i,2)
218 vz(i,8) =vz(i,2)
219 ENDIF
220
221 IF(nvoisin(4,l)/=0)ix=iabs(nvoisin(4,l))
222 ixx(i,9)=ix
223 IF(ix /= 0)THEN
224 xx0(i,9)=x(1,ix)
225 yy0(i,9)=x(2,ix)
226 zz0(i,9)=x(3,ix)
227 vx(i,9)=v(1,ix)
228 vy(i,9)=v(2,ix)
229 vz(i,9)=v(3,ix)
230 ELSE
231 xx0(i,9)=xx0(i,3)
232 yy0(i,9)=yy0(i,3)
233 zz0(i,9)=zz0(i,3)
234 vx(i,9) =vx(i,3)
235 vy(i,9) =vy(i,3)
236 vz(i,9) =vz(i,3)
237 ENDIF
238
239 IF(nvoisin(3,l)<0)THEN
240 IF(nvoisin(4,l)<0)THEN
241 itriv(2,i)=4
242 ELSE
243 itriv(2,i)=2
244 ENDIF
245 ELSEIF(nvoisin(4,l)<0)THEN
246 itriv(2,i)=3
247 ELSE
248 itriv(2,i)=1
249 ENDIF
250
251
252 ix=iabs(nvoisin(5,l))
253 ixx(i,10)=ix
254 IF(ix /= 0)THEN
255 xx0(i,10)=x(1,ix)
256 yy0(i,10)=x(2,ix)
257 zz0(i,10)=x(3,ix)
258 vx(i,10)=v(1,ix)
259 vy(i,10)=v(2,ix)
260 vz(i,10)=v(3,ix)
261 ELSE
262 xx0(i,10)=xx0(i,3)
263 yy0(i,10)=yy0(i,3)
264 zz0(i,10)=zz0(i,3)
265 vx(i,10) =vx(i,3)
266 vy(i,10) =vy(i,3)
267 vz(i,10) =vz(i,3)
268 ENDIF
269
270 IF(nvoisin(6,l)/=0)ix=iabs(nvoisin(6,l))
271 ixx(i,11)=ix
272 IF(ix /= 0)THEN
273 xx0(i,11)=x(1,ix)
274 yy0(i,11)=x(2,ix)
275 zz0(i,11)=x(3,ix)
276 vx(i,11)=v(1,ix)
277 vy(i,11)=v(2,ix)
278 vz(i,11)=v(3,ix)
279 ELSE
280 xx0(i,11)=xx0(i,4)
281 yy0(i,11)=yy0(i,4)
282 zz0(i,11)=zz0(i,4)
283 vx(i,11) =vx(i,4)
284 vy(i,11) =vy(i,4)
285 vz(i,11) =vz(i,4)
286 ENDIF
287
288
289 IF(nvoisin(5,l)<0)THEN
290 IF(nvoisin(6,l)<0)THEN
291 itriv(3,i)=4
292 ELSE
293 itriv(3,i)=2
294 ENDIF
295 ELSEIF(nvoisin(6,l)<0)THEN
296 itriv(3,i)=3
297 ELSE
298 itriv(3,i)=1
299 ENDIF
300
301 ix=iabs(nvoisin(7,l))
302 ixx(i,12)=ix
303 IF(ix /= 0)THEN
304 xx0(i,12)=x(1,ix)
305 yy0(i,12)=x(2,ix)
306 zz0(i,12)=x(3,ix)
307 vx(i,12)=v(1,ix)
308 vy(i,12)=v(2,ix)
309 vz(i,12)=v(3,ix)
310 ELSE
311 xx0(i,12)=xx0(i,4)
312 yy0(i,12)=yy0(i,4)
313 zz0(i,12)=zz0(i,4)
314 vx(i,12) =vx(i,4)
315 vy(i,12) =vy(i,4)
316 vz(i,12) =vz(i,4)
317 ENDIF
318
319 IF(nvoisin(8,l)/=0)ix=iabs(nvoisin(8,l))
320 ixx(i,13)=ix
321 IF(ix /= 0)THEN
322 xx0(i,13)=x(1,ix)
323 yy0(i,13)=x(2,ix)
324 zz0(i,13)=x(3,ix)
325 vx(i,13)=v(1,ix)
326 vy(i,13)=v(2,ix)
327 vz(i,13)=v(3,ix)
328 ELSE
329 xx0(i,13)=xx0(i,1)
330 yy0(i,13)=yy0(i,1)
331 zz0(i,13)=zz0(i,1)
332 vx(i,13) =vx(i,1)
333 vy(i,13) =vy(i,1)
334 vz(i,13) =vz(i,1)
335 ENDIF
336
337 IF(nvoisin(7,l)<0)THEN
338 IF(nvoisin(8,l)<0)THEN
339 itriv(4,i)=4
340 ELSE
341 itriv(4,i)=2
342 ENDIF
343 ELSEIF(nvoisin(8,l)<0)THEN
344 itriv(4,i)=3
345 ELSE
346 itriv(4,i)=1
347 ENDIF
348
349 IF(ixx(i, 6)==ixx(i, 7))THEN
350 xx0(i,14) = xx0(i,6)
351 yy0(i,14) = yy0(i,6)
352 zz0(i,14) = zz0(i,6)
353 vx(i,14) = vx(i,6)
354 vy(i,14) = vy(i,6)
355 vz(i,14) = vz(i,6)
356 ELSE
357 xx0(i,14) = fourth*(xx0(i,2)+xx0(i,1)+xx0(i,6)+xx0(i,7))
358 yy0(i,14) = fourth*(yy0(i,2)+yy0(i,1)+yy0(i,6)+yy0(i,7))
359 zz0(i,14) = fourth*(zz0(i,2)+zz0(i,1)+zz0(i,6)+zz0(i,7))
360 vx(i,14) = fourth*(vx(i,2)+vx(i,1)+vx(i,6)+vx(i,7))
361 vy(i,14) = fourth*(vy(i,2)+vy(i,1)+vy(i,6)+vy(i,7))
362 vz(i,14) = fourth*(vz(i,2)+vz(i,1)+vz(i,6)+vz(i,7))
363 ENDIF
364 IF(ixx(i, 8)==ixx(i, 9))THEN
365 xx0(i,15) = xx0(i,8)
366 yy0(i,15) = yy0(i,8)
367 zz0(i,15) = zz0(i,8)
368 vx(i,15) = vx(i,8)
369 vy(i,15) = vy(i,8)
370 vz(i,15) = vz(i,8)
371 ELSE
372 xx0(i,15) = fourth*(xx0(i,3)+xx0(i,2)+xx0(i,8)+xx0(i,9))
373 yy0(i,15) = fourth*(yy0(i,3)+yy0(i,2)+yy0(i,8)+yy0(i,9))
374 zz0(i,15) = fourth*(zz0(i,3)+zz0(i,2)+zz0(i,8)+zz0(i,9))
375 vx(i,15) = fourth*(vx(i,3)+vx(i,2)+vx(i,8)+vx(i,9))
376 vy(i,15) = fourth*(vy(i,3)+vy(i,2)+vy(i,8)+vy(i,9))
377 vz(i,15) = fourth*(vz(i,3)+vz(i,2)+vz(i,8)+vz(i,9))
378 ENDIF
379 IF(ixx(i,10)==ixx(i,11))THEN
380 xx0(i,16) = xx0(i,10)
381 yy0(i,16) = yy0(i,10)
382 zz0(i,16) = zz0(i,10)
383 vx(i,16) = vx(i,10)
384 vy(i,16) = vy(i,10)
385 vz(i,16) = vz(i,10)
386 ELSE
387 xx0(i,16) = fourth*(xx0(i,4)+xx0(i,3)+xx0(i,10)+xx0(i,11))
388 yy0(i,16) = fourth*(yy0(i,4)+yy0(i,3)+yy0(i,10)+yy0(i,11))
389 zz0(i,16) = fourth*(zz0(i,4)+zz0(i,3)+zz0(i,10)+zz0(i,11))
390 vx(i,16) = fourth*(vx(i,4)+vx(i,3)+vx(i,10)+vx(i,11))
391 vy(i,16) = fourth*(vy(i,4)+vy(i,3)+vy(i,10)+vy(i,11))
392 vz(i,16) = fourth*(vz(i,4)+vz(i,3)+vz(i,10)+vz(i,11))
393 ENDIF
394 IF(ixx(i,12)==ixx(i,13))THEN
395 xx0(i,17) = xx0(i,12)
396 yy0(i,17) = yy0(i,12)
397 zz0(i,17) = zz0(i,12)
398 vx(i,17) = vx(i,12)
399 vy(i,17) = vy(i,12)
400 vz(i,17) = vz(i,12)
401 ELSE
402 xx0(i,17) = fourth*(xx0(i,1)+xx0(i,4)+xx0(i,12)+xx0(i,13))
403 yy0(i,17) = fourth*(yy0(i,1)+yy0(i,4)+yy0(i,12)+yy0(i,13))
404 zz0(i,17) = fourth*(zz0(i,1)+zz0(i,4)+zz0(i,12)+zz0(i,13))
405 vx(i,17) = fourth*(vx(i,1)+vx(i,4)+vx(i,12)+vx(i,13))
406 vy(i,17) = fourth*(vy(i,1)+vy(i,4)+vy(i,12)+vy(i,13))
407 vz(i,17) = fourth*(vz(i,1)+vz(i,4)+vz(i,12)+vz(i,13))
408 ENDIF
409
410 END DO
411 IF(igsti<=1)THEN
412 DO i=1,jlt
413 l = iabs(cand_e(i))
414 ni = cand_n(i)
415 IF(ni<=nsn)THEN
416 stif(i)=stf(l)*abs(stfn(ni))
417 ELSE
418 nn = ni - nsn
419 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
420 END IF
421 ENDDO
422 ELSEIF(igsti==2)THEN
423 DO i=1,jlt
424 l = iabs(cand_e(i))
425 ni = cand_n(i)
426 IF(ni<=nsn)THEN
427 stif(i)=abs(stfn(ni))
428 ELSE
429 nn = ni - nsn
430 stif(i)=abs(stifi(nin)%P(nn))
431 END IF
432 stif(i)=half*(stf(l)+stif(i))
433 stif(i)=max(kmin,min(stif(i),kmax))
434 ENDDO
435 ELSEIF(igsti==3)THEN
436 DO i=1,jlt
437 l = iabs(cand_e(i))
438 ni = cand_n(i)
439 IF(ni<=nsn)THEN
440 stif(i)=abs(stfn(ni))
441 ELSE
442 nn = ni - nsn
443 stif(i)=abs(stifi(nin)%P(nn))
444 END IF
445 stif(i)=max(stf(l),stif(i))
446 stif(i)=max(kmin,min(stif(i),kmax))
447 ENDDO
448 ELSEIF(igsti==4.OR.igsti==6)THEN
449 DO i=1,jlt
450 l = iabs(cand_e(i))
451 ni = cand_n(i)
452 IF(ni<=nsn)THEN
453 stif(i)=abs(stfn(ni))
454 ELSE
455 nn = ni - nsn
456 stif(i)=abs(stifi(nin)%P(nn))
457 END IF
458 stif(i)=min(stf(l),stif(i))
459 stif(i)=max(kmin,min(stif(i),kmax))
460 ENDDO
461 ELSEIF(igsti==5)THEN
462 DO i=1,jlt
463 l = iabs(cand_e(i))
464 ni = cand_n(i)
465 IF(ni<=nsn)THEN
466 stif(i)=abs(stfn(ni))
467 ELSE
468 nn = ni - nsn
469 stif(i)=abs(stifi(nin)%P(nn))
470 END IF
471 stif(i)=stf(l)*stif(i)/
472 . max(em30,(stf(l)+stif(i)))
473 stif(i)=max(kmin,min(stif(i),kmax))
474 ENDDO
475 ENDIF
476C
477 RETURN
478 END
479C
480!||====================================================================
481!|| i24corp3 ../engine/source/interfaces/int24/i24cork3.F
482!||--- called by ------------------------------------------------------
483!|| i7forcf3 ../engine/source/interfaces/int07/i7ke3.F
484!||--- calls -----------------------------------------------------
485!|| arret ../engine/source/system/arret.F
486!||--- uses -----------------------------------------------------
487!|| imp_intm ../engine/share/modules/imp_intm.F
488!|| tri7box ../engine/share/modules/tri7box.F
489!||====================================================================
490 SUBROUTINE i24corp3(JLT ,X ,IRECT ,CAND_E ,CAND_N ,
491 1 STIF ,H1 ,H2 ,H3 ,H4 ,
492 2 N1 ,N2 ,N3 ,IX1 ,IX2 ,
493 3 IX3 ,IX4 ,NSVG ,VXI ,VYI ,
494 4 VZI ,MSI ,DXI ,DYI ,DZI ,
495 5 NSN ,NIN ,JLT_NEW ,LREM )
496C-----------------------------------------------
497C M o d u l e s
498C-----------------------------------------------
499 USE tri7box
500 USE imp_intm
501C-----------------------------------------------
502C I m p l i c i t T y p e s
503C-----------------------------------------------
504#include "implicit_f.inc"
505C-----------------------------------------------
506C G l o b a l P a r a m e t e r s
507C-----------------------------------------------
508#include "mvsiz_p.inc"
509C-----------------------------------------------
510C D u m m y A r g u m e n t s
511C-----------------------------------------------
512 INTEGER IRECT(4,*), CAND_E(*), CAND_N(*),
513 . jlt,jlt_new,nin,nsn,lrem
514 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
515 . NSVG(MVSIZ)
516C REAL
517C REAL
518 my_real
519 . VXI(MVSIZ), VYI(MVSIZ), VZI(MVSIZ), MSI(MVSIZ),
520 . X(3,*), STIF(*),N1(MVSIZ), N2(MVSIZ), N3(MVSIZ),
521 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
522 . DXI(MVSIZ),DYI(MVSIZ),DZI(MVSIZ)
523C-----------------------------------------------
524C L o c a l V a r i a b l e s
525C-----------------------------------------------
526 INTEGER I ,J ,NI, L, NN, NS ,NE,IC(4,4),ITQ
527 DATA ic /
528 1 3, 4, 1, 2,
529 2 4, 1, 2, 3,
530 3 1, 2, 3, 4,
531 4 2, 3, 4, 1/
532C-----------------------------------------------
533C
534 DO i=1,jlt
535 ni = cand_n(i)
536 l = cand_e(i)
537 IF(ni>nsn)THEN
538 nn = ni - nsn
539 jlt_new = jlt_new + 1
540 vxi(jlt_new)= vfi(nin)%P(1,nn)
541 vyi(jlt_new)= vfi(nin)%P(2,nn)
542 vzi(jlt_new)= vfi(nin)%P(3,nn)
543 msi(jlt_new)= msfi(nin)%P(nn)
544 itq = irtlm_fi(nin)%P(2,nn)
545 IF (itq>4.OR.itq==0) THEN
546 print *,'Internal Error, ITQ=',itq
547 CALL arret(2)
548 END IF
549 ix1(jlt_new) = irect(ic(1,itq),l)
550 ix2(jlt_new) = irect(ic(2,itq),l)
551 ix3(jlt_new) = irect(ic(3,itq),l)
552 ix4(jlt_new) = irect(ic(4,itq),l)
553 ns=ind_int(nin)%P(nn)
554 ne=shf_int(nin)+jlt_new+lrem
555 nsvg(jlt_new) = ns
556 h1(jlt_new) = h_e(1,ne)
557 h2(jlt_new) = h_e(2,ne)
558 h3(jlt_new) = h_e(3,ne)
559 h4(jlt_new) = h_e(4,ne)
560 stif(jlt_new)=stifs(ne)
561 n1(jlt_new)=n_e(1,ne)
562 n2(jlt_new)=n_e(2,ne)
563 n3(jlt_new)=n_e(3,ne)
564C----------displacement
565 dxi(jlt_new)=dfi(1,ns)
566 dyi(jlt_new)=dfi(2,ns)
567 dzi(jlt_new)=dfi(3,ns)
568C
569 END IF
570C
571 END DO
572C
573 RETURN
574 END
575!||====================================================================
576!|| i24corkm ../engine/source/interfaces/int24/i24cork3.F
577!||--- called by ------------------------------------------------------
578!|| i24ke3 ../engine/source/interfaces/int24/i24ke3.F
579!||--- calls -----------------------------------------------------
580!|| i24msegv1 ../engine/source/interfaces/int24/i24cork3.F
581!||--- uses -----------------------------------------------------
582!|| tri7box ../engine/share/modules/tri7box.F
583!||====================================================================
584 SUBROUTINE i24corkm(
585 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
586 2 CAND_N ,STIF ,STIF_IMP,XI ,YI ,
587 3 ZI ,VXI ,VYI ,VZI ,IX1 ,
588 4 IX2 ,IX3 ,IX4 ,NSVG ,NVOISIN,
589 5 MS ,MSI ,NSN ,V ,NIN ,
590 6 N1 ,N2 ,N3 ,H1 ,H2 ,
591 7 H3 ,H4 ,NJ_IMP ,HJ_IMP ,SUBTRIA)
592C-----------------------------------------------
593C M o d u l e s
594C-----------------------------------------------
595 USE tri7box
596C-----------------------------------------------
597C I m p l i c i t T y p e s
598C-----------------------------------------------
599#include "implicit_f.inc"
600C-----------------------------------------------
601C G l o b a l P a r a m e t e r s
602C-----------------------------------------------
603#include "mvsiz_p.inc"
604C-----------------------------------------------
605C D u m m y A r g u m e n t s
606C-----------------------------------------------
607 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
608 . JLT,NSN, NIN, NVOISIN(8,*),SUBTRIA(*)
609 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ), NSVG(MVSIZ)
610C REAL
611 my_real
612 . X(3,*), STIF_IMP(*), MS(*), V(3,*),N1(*),N2(*),N3(*),
613 . H1(*),H2(*),H3(*),H4(*),NJ_IMP(3,*),HJ_IMP(4,*)
614C REAL
615 my_real
616 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
617 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz)
618C-----------------------------------------------
619C L o c a l V a r i a b l e s
620C-----------------------------------------------
621 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI,IRTLM(4),NE,NEI
622C-----------------------------------------------
623C
624C
625 DO I=1,jlt
626 ni = cand_n(i)
627 ne = cand_e(i)
628 l = iabs(ne)
629 IF(ni<=nsn)THEN
630 ig = nsv(ni)
631 nsvg(i) = ig
632c KINI(I) = KINET(IG)
633 xi(i) = x(1,ig)
634 yi(i) = x(2,ig)
635 zi(i) = x(3,ig)
636 vxi(i) = v(1,ig)
637 vyi(i) = v(2,ig)
638 vzi(i) = v(3,ig)
639 msi(i)= ms(ig)
640 ELSE
641 nn = ni - nsn
642 nsvg(i) = -nn
643c KINI(I) = KINFI(NIN)%P(NN)
644 xi(i) = xfi(nin)%P(1,nn)
645 yi(i) = xfi(nin)%P(2,nn)
646 zi(i) = xfi(nin)%P(3,nn)
647 vxi(i)= vfi(nin)%P(1,nn)
648 vyi(i)= vfi(nin)%P(2,nn)
649 vzi(i)= vfi(nin)%P(3,nn)
650 msi(i)= msfi(nin)%P(nn)
651 END IF
652C
653 IF (ne<0) THEN
654 nei=-ne
655 CALL i24msegv1(irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
656 ix1(i) = irtlm(1)
657 ix2(i) = irtlm(2)
658 ix3(i) = irtlm(3)
659 ix4(i) = irtlm(4)
660 ELSE
661 ix1(i) = irect(1,l)
662 ix2(i) = irect(2,l)
663 ix3(i) = irect(3,l)
664 ix4(i) = irect(4,l)
665 END IF
666 stif(i) = stif_imp(i)
667 n1(i) = nj_imp(1,i)
668 n2(i) = nj_imp(2,i)
669 n3(i) = nj_imp(3,i)
670 h1(i) = hj_imp(1,i)
671 h2(i) = hj_imp(2,i)
672 h3(i) = hj_imp(3,i)
673 h4(i) = hj_imp(4,i)
674 END DO
675C
676 RETURN
677 END
678!||====================================================================
679!|| i24msegv1 ../engine/source/interfaces/int24/i24cork3.F
680!||--- called by ------------------------------------------------------
681!|| i24corkm ../engine/source/interfaces/int24/i24cork3.F
682!||====================================================================
683 SUBROUTINE i24msegv1(IRTLMV ,SUBTRIA,IRTLM ,NVOISIN)
684C-----------------------------------------------
685C I m p l i c i t T y p e s
686C-----------------------------------------------
687#include "implicit_f.inc"
688C-----------------------------------------------
689C D u m m y A r g u m e n t s
690C-----------------------------------------------
691 INTEGER IRTLMV(4),IRTLM(4),SUBTRIA,NVOISIN(8)
692C-----------------------------------------------
693C L o c a l V a r i a b l e s
694C-----------------------------------------------
695 INTEGER IX,IC(4,20),IXX(13),j
696C-----------------------------------------------
697C 11-------10
698C |\ 19 /|
699C | \ / |
700C | \ / |
701C | 16 |
702C |15/ \11|
703C | / \ |
704C |/ 7 \|
705C12-------4-------3-------9
706C |\ 12 /|\ /|\ 14 /|
707C | \ / | \ 3 / | \ / |
708C | \ / | \ /2 |6 \ /18|
709C | 17 | 5 | 15 |
710C |20/ \ 8| 4/ \ | / \ |
711C | / \ | / 1 \ | / \ |
712C |/ 16 \|/ \|/ 10 \|
713C13-------1-------2-------8
714C |\ 5 /|
715C | \ / |
716C |9 \ /13|
717C | 14 |
718C | / \ |
719C | / \ |
720C |/ 17 \|
721C 6-------7
722C-----------------------------------------
723 DATA ic /
724 1 3, 4, 1, 2,
725 2 4, 1, 2, 3,
726 3 1, 2, 3, 4,
727 4 2, 3, 4, 1,
728 5 6, 7, 2, 1,
729 6 8, 9, 3, 2,
730 7 10,11, 4, 3,
731 8 12,13, 1, 4,
732 9 7, 2, 1, 6,
733 . 9, 3, 2, 8,
734 1 11, 4, 3,10,
735 2 13, 1, 4,12,
736 3 1, 6, 7, 2,
737 4 2, 8, 9, 3,
738 5 3,10,11, 4,
739 6 4,12,13, 1,
740 7 2, 1, 6, 7,
741 8 3, 2, 8, 9,
742 9 4, 3,10,11,
743 . 1, 4,12,13/
744C---------different than I24MSEGV(ind_glob_k.F), consisting order of IXJ w/ Hj
745 ixx(1:4)=irtlm(1:4)
746 ix=iabs(nvoisin(1))
747 ixx(6)=ix
748 IF(nvoisin(2)/=0)ix=iabs(nvoisin(2))
749 ixx(7)=ix
750 ix=iabs(nvoisin(3))
751 ixx(8)=ix
752 IF(nvoisin(4)/=0)ix=iabs(nvoisin(4))
753 ixx(9)=ix
754 ix=iabs(nvoisin(5))
755 ixx(10)=ix
756 IF(nvoisin(6)/=0)ix=iabs(nvoisin(6))
757 ixx(11)=ix
758 ix=iabs(nvoisin(7))
759 ixx(12)=ix
760 IF(nvoisin(8)/=0)ix=iabs(nvoisin(8))
761 ixx(13)=ix
762C
763 irtlmv(1) = ixx(ic(1,subtria))
764 irtlmv(2) = ixx(ic(2,subtria))
765 irtlmv(3) = ixx(ic(3,subtria))
766 irtlmv(4) = ixx(ic(4,subtria))
767C
768 RETURN
769 END
770C
i24msegv1
subroutine i24msegv1(irtlmv, subtria, irtlm, nvoisin)
Definition i24cork3.F:684
i24cork3
subroutine i24cork3(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, xx0, yy0, zz0, vx, vy, vz, xi, yi, zi, vxi, vyi, vzi, ixx, nsvg, nvoisin, ms, msi, nsn, v, kini, ity, nin, igsti, kmin, kmax, gap_s, gaps, itriv)
Definition i24cork3.F:37
i24corp3
subroutine i24corp3(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 i24cork3.F:496
i24corkm
subroutine i24corkm(jlt, x, irect, nsv, cand_e, cand_n, stif, stif_imp, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nvoisin, ms, msi, nsn, v, nin, n1, n2, n3, h1, h2, h3, h4, nj_imp, hj_imp, subtria)
Definition i24cork3.F:592
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
imp_intm
Definition imp_intm.F:118
imp_intm::shf_int
integer, dimension(:), allocatable shf_int
Definition imp_intm.F:136
imp_intm::ind_int
type(int_pointer2), dimension(:), allocatable ind_int
Definition imp_intm.F:133
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
arret
subroutine arret(nn)
Definition arret.F:87