OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23sto.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!|| i23sto ../engine/source/interfaces/int23/i23sto.F
25!||--- called by ------------------------------------------------------
26!|| i23trivox ../engine/source/interfaces/intsort/i23trivox.F
27!||--- calls -----------------------------------------------------
28!|| i23cor3t ../engine/source/interfaces/int23/i23cor3t.F
29!|| i7pen3 ../engine/source/interfaces/intsort/i7pen3.F
30!||====================================================================
31 SUBROUTINE i23sto(
32 1 J_STOK ,IRECT ,X ,NSV ,II_STOK,
33 2 CAND_N ,CAND_E ,MULNSN ,NOINT ,MARGE ,
34 3 I_MEM ,PROV_N ,PROV_E ,ESHIFT ,INACTI ,
35 4 IGAP ,GAP ,GAP_S ,GAP_M ,GAPMIN ,
36 5 GAPMAX ,CURV_MAX ,MSR ,NSN ,OLDNUM ,
37 6 NSNROLD,CAND_A ,IFPEN ,CAND_P )
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42#include "comlock.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER I_MEM, NSN,NSNROLD,IGAP
51 INTEGER J_STOK,MULNSN,NOINT,INACTI,ESHIFT
52 INTEGER IRECT(4,*),CAND_N(*),CAND_E(*),CAND_A(*),NSV(*),MSR(*)
53 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IFPEN(*), OLDNUM(*),II_STOK
54C REAL
55 my_real
56 . x(3,*), gap_s(*), gap_m(*),
57 . marge, gap, gapmin, gapmax, curv_max(*),
58 . cand_p(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,K_STOK,I_STOK,N,NE,J
63 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
64C REAL
65 my_real
66 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
67 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
68 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
69 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
70 . pene(mvsiz), gapv(mvsiz)
71C-----------------------------------------------
72 CALL i23cor3t(j_stok ,x ,irect ,prov_e ,
73 1 prov_n ,igap ,gap ,x1 ,x2 ,
74 2 x3 ,x4 ,y1 ,y2 ,y3 ,
75 3 y4 ,z1 ,z2 ,z3 ,z4 ,
76 4 xi ,yi ,zi ,ix1 ,ix2 ,
77 5 ix3 ,ix4 ,nsn ,gap_s ,gapv ,
78 6 gapmax ,gapmin,curv_max,nsv,msr ,
79 7 gap_m )
80C-----------------------------------------------
81 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
82 . x4 ,y1 ,y2 ,y3 ,y4 ,
83 . z1 ,z2 ,z3 ,z4 ,xi ,
84 . yi ,zi ,pene ,ix1 ,ix2 ,
85 . ix3 ,ix4 ,igap ,gap ,gapv )
86C-----------------------------------------------
87C REMOVAL OF OLD CANDIDATES ALREADY STORED (INITIAL PENETRATION)
88C-----------------------------------------------
89 DO i=1,j_stok
90 IF(pene(i)/=zero)THEN
91 n = prov_n(i)
92 ne = prov_e(i)+eshift
93 IF(n>nsn) THEN
94C Numbering of previous triangles for non-local nodes (SPMD)
95 n = oldnum(n-nsn)+nsn
96 IF(n==nsn) n = nsn+nsnrold+1
97 END IF
98 j = cand_a(n)
99 DO WHILE(j<=cand_a(n+1)-1)
100 IF(cand_e(j)==ne)THEN
101 pene(i)=zero
102 j=cand_a(n+1)
103 ELSE
104 j=j+1
105 ENDIF
106 ENDDO
107 ENDIF
108 ENDDO
109C-----------------------------------------------
110 k_stok = 0
111 DO i=1,j_stok
112 IF(pene(i)/=zero) k_stok = k_stok + 1
113 ENDDO
114 IF(k_stok==0)RETURN
115C
116#include "lockon.inc"
117 i_stok = ii_stok
118 IF(i_stok+k_stok>mulnsn) THEN
119 i_mem = 2
120#include "lockoff.inc"
121 RETURN
122 ENDIF
123 ii_stok = i_stok + k_stok
124#include "lockoff.inc"
125C-----------------------------------------------
126 DO i=1,j_stok
127 IF(pene(i)/=zero)THEN
128 i_stok = i_stok + 1
129 cand_n(i_stok) = prov_n(i)
130 cand_e(i_stok) = prov_e(i)+eshift
131 ifpen(i_stok) = 0
132 cand_p(i_stok) = zero
133 ENDIF
134 ENDDO
135 RETURN
136
137C To be redone
138c DO I=1,J_STOK
139c IF(PENE(I)/=ZERO)THEN
140c I_STOK = I_STOK + 1
141c CAND_N(I_STOK) = PROV_N(I)
142c CAND_E(I_STOK) = PROV_E(I)+ESHIFT
143cC
144c N = PROV_N(I)
145c NE = PROV_E(I)+ESHIFT
146c N1 = IRECTG(1,NE)
147c N2 = IRECTG(2,NE)
148c N3 = IRECTG(3,NE)
149c N4 = IRECTG(4,NE)
150c ITAGP(N1)=1
151c ITAGP(N2)=1
152c ITAGP(N3)=1
153c ITAGP(N4)=1
154c IF(N>NSN) THEN
155c This is sorted previously for non-local nodes (SPMD)
156c N = OLDNUM(N-NSN)+NSN
157c IF(N==NSN) N = NSN+NSNROLD+1
158c END IF
159c IFPEN(I_STOK) = 0
160c CAND_P(I_STOK) = ZERO
161cC
162cC look for a previous contact w/neighbour
163c J = CAND_A(N)
164c DO WHILE(J<=CAND_A(N+1)-1)
165c ME=CAND_E(J)
166c IF(ME/=NE)THEN
167c M1 = IRECTG(1,ME)
168c M2 = IRECTG(2,ME)
169c M3 = IRECTG(3,ME)
170c M4 = IRECTG(4,ME)
171c IF((ITAGP(M1)/=0.AND.ITAGP(M2)/=0).OR.
172c . (ITAGP(M2)/=0.AND.ITAGP(M3)/=0).OR.
173c . (M4/=M3.AND.ITAGP(M3)/=0.AND.ITAGP(M4)/=0).OR.
174c . (M4/=M3.AND.ITAGP(M4)/=0.AND.ITAGP(M1)/=0).OR.
175c . (M4==M3.AND.ITAGP(M3)/=0.AND.ITAGP(M1)/=0))THEN
176cC
177c Retains information from 1 neighbor only (1st penetrated)
178c It must be redone / sorted
179c IF(ABS(IFPEN(J)) > ABS(IFPEN(I_STOK)))THEN
180c IFPEN(I_STOK) = IFPEN(J)
181c CAND_P(I_STOK) = CAND_P(J)
182c END IF
183c ENDIF
184c J=J+1
185c END IF
186c ENDDO
187c ITAGP(N1)=0
188c ITAGP(N2)=0
189c ITAGP(N3)=0
190c ITAGP(N4)=0
191c ENDIF
192c ENDDO
193C-----------------------------------------------
194 RETURN
195 END
i23sto
subroutine i23sto(j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, msr, nsn, oldnum, nsnrold, cand_a, ifpen, cand_p)
Definition i23sto.F:38
i23cor3t
subroutine i23cor3t(x, irect, nsv, cand_e, cand_n, gapv, igap, gap, gap_s, gapmin, gapmax, msr, gap_m, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi)
Definition i23cor3t.F:36
i7pen3
subroutine i7pen3(marge, gapv, n1, n2, n3, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, last)
Definition i7pen3.F:43