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 . ME,N1,N2,N3,N4,M1,M2,M3,M4
64 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
65C REAL
66 my_real
67 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
68 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
69 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
70 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
71 . nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
72 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
73 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
74 . pene(mvsiz), gapv(mvsiz)
75C-----------------------------------------------
76 CALL i23cor3t(j_stok ,x ,irect ,prov_e ,
77 1 prov_n ,igap ,gap ,x1 ,x2 ,
78 2 x3 ,x4 ,y1 ,y2 ,y3 ,
79 3 y4 ,z1 ,z2 ,z3 ,z4 ,
80 4 xi ,yi ,zi ,ix1 ,ix2 ,
81 5 ix3 ,ix4 ,nsn ,gap_s ,gapv ,
82 6 gapmax ,gapmin,curv_max,nsv,msr ,
83 7 gap_m )
84C-----------------------------------------------
85 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
86 . x4 ,y1 ,y2 ,y3 ,y4 ,
87 . z1 ,z2 ,z3 ,z4 ,xi ,
88 . yi ,zi ,pene ,ix1 ,ix2 ,
89 . ix3 ,ix4 ,igap ,gap ,gapv )
90C-----------------------------------------------
91C SUPPRESSION DES ANCIENS CANDIDATS DEJE STOCKES (PENE INITIALE)
92C-----------------------------------------------
93 DO i=1,j_stok
94 IF(pene(i)/=zero)THEN
95 n = prov_n(i)
96 ne = prov_e(i)+eshift
97 IF(n>nsn) THEN
98C numerotation tris precedent pour les noeuds non locaux (SPMD)
99 n = oldnum(n-nsn)+nsn
100 IF(n==nsn) n = nsn+nsnrold+1
101 END IF
102 j = cand_a(n)
103 DO WHILE(j<=cand_a(n+1)-1)
104 IF(cand_e(j)==ne)THEN
105 pene(i)=zero
106 j=cand_a(n+1)
107 ELSE
108 j=j+1
109 ENDIF
110 ENDDO
111 ENDIF
112 ENDDO
113C-----------------------------------------------
114 k_stok = 0
115 DO i=1,j_stok
116 IF(pene(i)/=zero) k_stok = k_stok + 1
117 ENDDO
118 IF(k_stok==0)RETURN
119C
120#include "lockon.inc"
121 i_stok = ii_stok
122 IF(i_stok+k_stok>mulnsn) THEN
123 i_mem = 2
124#include "lockoff.inc"
125 RETURN
126 ENDIF
127 ii_stok = i_stok + k_stok
128#include "lockoff.inc"
129C-----------------------------------------------
130 DO i=1,j_stok
131 IF(pene(i)/=zero)THEN
132 i_stok = i_stok + 1
133 cand_n(i_stok) = prov_n(i)
134 cand_e(i_stok) = prov_e(i)+eshift
135 ifpen(i_stok) = 0
136 cand_p(i_stok) = zero
137 ENDIF
138 ENDDO
139 RETURN
140
141C a refaire
142c DO I=1,J_STOK
143c IF(PENE(I)/=ZERO)THEN
144c I_STOK = I_STOK + 1
145c CAND_N(I_STOK) = PROV_N(I)
146c CAND_E(I_STOK) = PROV_E(I)+ESHIFT
147cC
148c N = PROV_N(I)
149c NE = PROV_E(I)+ESHIFT
150c N1 = IRECTG(1,NE)
151c N2 = IRECTG(2,NE)
152c N3 = IRECTG(3,NE)
153c N4 = IRECTG(4,NE)
154c ITAGP(N1)=1
155c ITAGP(N2)=1
156c ITAGP(N3)=1
157c ITAGP(N4)=1
158c IF(N>NSN) THEN
159cC numerotation tris precedent pour les noeuds non locaux (SPMD)
160c N = OLDNUM(N-NSN)+NSN
161c IF(N==NSN) N = NSN+NSNROLD+1
162c END IF
163c IFPEN(I_STOK) = 0
164c CAND_P(I_STOK) = ZERO
165cC
166cC look for a previous contact w/neighbour
167c J = CAND_A(N)
168c DO WHILE(J<=CAND_A(N+1)-1)
169c ME=CAND_E(J)
170c IF(ME/=NE)THEN
171c M1 = IRECTG(1,ME)
172c M2 = IRECTG(2,ME)
173c M3 = IRECTG(3,ME)
174c M4 = IRECTG(4,ME)
175c IF((ITAGP(M1)/=0.AND.ITAGP(M2)/=0).OR.
176c . (ITAGP(M2)/=0.AND.ITAGP(M3)/=0).OR.
177c . (M4/=M3.AND.ITAGP(M3)/=0.AND.ITAGP(M4)/=0).OR.
178c . (M4/=M3.AND.ITAGP(M4)/=0.AND.ITAGP(M1)/=0).OR.
179c . (M4==M3.AND.ITAGP(M3)/=0.AND.ITAGP(M1)/=0))THEN
180cC
181cC retains information from 1 neighbor only (1st penetrated)
182cCa doit etre refait / tri
183c IF(ABS(IFPEN(J)) > ABS(IFPEN(I_STOK)))THEN
184c IFPEN(I_STOK) = IFPEN(J)
185c CAND_P(I_STOK) = CAND_P(J)
186c END IF
187c ENDIF
188c J=J+1
189c END IF
190c ENDDO
191c ITAGP(N1)=0
192c ITAGP(N2)=0
193c ITAGP(N3)=0
194c ITAGP(N4)=0
195c ENDIF
196c ENDDO
197C-----------------------------------------------
198 RETURN
199 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