OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7sto.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!|| i7sto ../engine/source/interfaces/intsort/i7sto.F
25!||--- called by ------------------------------------------------------
26!|| i7tri ../engine/source/interfaces/intsort/i7tri.F
27!|| i7trivox ../engine/source/interfaces/intsort/i7trivox.F
28!||--- calls -----------------------------------------------------
29!|| i7cor3t ../engine/source/interfaces/int07/i7cor3t.f
30!|| i7pen3 ../engine/source/interfaces/intsort/i7pen3.F
31!||====================================================================
32 SUBROUTINE i7sto(
33 1 J_STOK,IRECT ,X ,NSV ,II_STOK,
34 2 CAND_N,CAND_E ,MULNSN,NOINT ,MARGE ,
35 3 I_MEM ,PROV_N ,PROV_E,ESHIFT,INACTI ,
36 4 IFQ ,CAND_A ,CAND_P,IFPEN ,NSN ,
37 5 OLDNUM,NSNROLD,IGAP ,GAP ,GAP_S ,
38 6 GAP_M ,GAPMIN ,GAPMAX,CURV_MAX,NIN ,
39 7 GAP_S_L,GAP_M_L,INTTH,DRAD,ITIED ,
40 8 CAND_F ,DGAPLOAD)
41C============================================================================
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER I_MEM, NSN, NSNROLD,IGAP,NIN,INTTH,ITIED
55 INTEGER J_STOK,MULNSN,NOINT,INACTI,IFQ,ESHIFT
56 INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_A(*)
57 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IFPEN(*), OLDNUM(*),
58 * II_STOK
59 my_real , INTENT(IN) :: DRAD,DGAPLOAD
60 my_real
61 . X(3,*), CAND_P(*), GAP_S(*), GAP_M(*),
62 . marge, gap, gapmin, gapmax,curv_max(*),
63 . gap_s_l(*),gap_m_l(*), cand_f(8,*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I,K_STOK,I_STOK,N,NE,J,ITYPE
68 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
69C REAL
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 . pene(mvsiz), gapv(mvsiz)
76 DATA itype/7/
77C-----------------------------------------------
78 CALL i7cor3t(j_stok ,x ,irect ,nsv ,prov_e ,
79 1 prov_n ,igap ,gap ,x1 ,x2 ,
80 2 x3 ,x4 ,y1 ,y2 ,y3 ,
81 3 y4 ,z1 ,z2 ,z3 ,z4 ,
82 4 xi ,yi ,zi ,stif ,ix1 ,
83 5 ix2 ,ix3 ,ix4 ,nsn ,gap_s ,
84 6 gap_m ,gapv ,gapmax,gapmin,curv_max,
85 7 itype ,nin ,gap_s_l,gap_m_l,intth ,
86 8 drad ,dgapload)
87C-----------------------------------------------
88 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
89 . x4 ,y1 ,y2 ,y3 ,y4 ,
90 . z1 ,z2 ,z3 ,z4 ,xi ,
91 . yi ,zi ,pene ,ix1 ,ix2 ,
92 . ix3 ,ix4 ,igap ,gap ,gapv )
93C-----------------------------------------------
94C SUPPRESSION DES ANCIENS CANDIDATS DEJE STOCKES (PENE INITIALE)
95C-----------------------------------------------
96 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
97 . itied/=0)THEN
98 DO i=1,j_stok
99 IF(pene(i)/=zero)THEN
100 n = prov_n(i)
101 ne = prov_e(i)+eshift
102 IF(n>nsn) THEN
103C numerotation tris precedent pour les noeuds non locaux (SPMD)
104 n = oldnum(n-nsn)+nsn
105 IF(n==nsn) n = nsn+nsnrold+1
106 END IF
107 j = cand_a(n)
108 DO WHILE(j<=cand_a(n+1)-1)
109 IF(cand_e(j)==ne)THEN
110 pene(i)=zero
111 j=cand_a(n+1)
112 ELSE
113 j=j+1
114 ENDIF
115 ENDDO
116 ENDIF
117 ENDDO
118 ENDIF
119C-----------------------------------------------
120 k_stok = 0
121 DO i=1,j_stok
122 IF(pene(i)/=zero) k_stok = k_stok + 1
123 ENDDO
124 IF(k_stok==0)RETURN
125C
126#include "lockon.inc"
127 i_stok = ii_stok
128 IF(i_stok+k_stok>mulnsn) THEN
129 i_mem = 2
130#include "lockoff.inc"
131 RETURN
132 ENDIF
133 ii_stok = i_stok + k_stok
134#include "lockoff.inc"
135C-----------------------------------------------
136 IF(ifq > 0 .AND.
137 . (inacti == 5 .OR. inacti ==6 .OR. inacti ==7).AND.itied /=0)THEN
138 DO i=1,j_stok
139 IF(pene(i)/=zero)THEN
140 i_stok = i_stok + 1
141 cand_n(i_stok) = prov_n(i)
142 cand_e(i_stok) = prov_e(i)+eshift
143 ifpen(i_stok) = 0
144 cand_p(i_stok) = zero
145 cand_f(1:8,i_stok)=zero
146 ENDIF
147 ENDDO
148 ELSEIF(ifq > 0 .AND.
149 . (inacti == 5 .OR. inacti ==6 .OR. inacti ==7))THEN
150 DO i=1,j_stok
151 IF(pene(i)/=0.0)THEN
152 i_stok = i_stok + 1
153 cand_n(i_stok) = prov_n(i)
154 cand_e(i_stok) = prov_e(i)+eshift
155 ifpen(i_stok) = 0
156 cand_p(i_stok) = zero
157 ENDIF
158 ENDDO
159 ELSEIF(ifq > 0..AND. itied /=0)THEN
160 DO i=1,j_stok
161 IF(pene(i)/=zero)THEN
162 i_stok = i_stok + 1
163 cand_n(i_stok) = prov_n(i)
164 cand_e(i_stok) = prov_e(i)+eshift
165 ifpen(i_stok) = 0
166 cand_f(1:8,i_stok)=zero
167 ENDIF
168 ENDDO
169 ELSEIF(ifq > 0)THEN
170 DO i=1,j_stok
171 IF(pene(i)/=zero)THEN
172 i_stok = i_stok + 1
173 cand_n(i_stok) = prov_n(i)
174 cand_e(i_stok) = prov_e(i)+eshift
175 ifpen(i_stok) = 0
176 ENDIF
177 ENDDO
178 ELSEIF((inacti==5.OR.inacti==6.OR.inacti==7).AND.itied /= 0)THEN
179 DO i=1,j_stok
180 IF(pene(i)/=zero)THEN
181 i_stok = i_stok + 1
182 cand_n(i_stok) = prov_n(i)
183 cand_e(i_stok) = prov_e(i)+eshift
184 cand_p(i_stok) = zero
185 cand_f(1:8,i_stok)=zero
186 ENDIF
187 ENDDO
188 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
189 DO i=1,j_stok
190 IF(pene(i)/=zero)THEN
191 i_stok = i_stok + 1
192 cand_n(i_stok) = prov_n(i)
193 cand_e(i_stok) = prov_e(i)+eshift
194 cand_p(i_stok) = zero
195 ENDIF
196 ENDDO
197 ELSEIF(itied /= 0)THEN
198 DO i=1,j_stok
199 IF(pene(i)/=zero)THEN
200 i_stok = i_stok + 1
201 cand_n(i_stok) = prov_n(i)
202 cand_e(i_stok) = prov_e(i)+eshift
203 cand_f(1:8,i_stok)=zero
204 ENDIF
205 ENDDO
206 ELSE
207 DO i=1,j_stok
208 IF(pene(i)/=zero)THEN
209 i_stok = i_stok + 1
210 cand_n(i_stok) = prov_n(i)
211 cand_e(i_stok) = prov_e(i)+eshift
212 ENDIF
213 ENDDO
214 ENDIF
215C-----------------------------------------------
216 RETURN
217 END
i7cor3t
subroutine i7cor3t(jlt, x, irect, nsv, cand_e, cand_n, igap, gap, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsn, gap_s, gap_m, gapv, gapmax, gapmin, curv_max, ityp, nin, gap_s_l, gap_m_l, intth, drad, dgapload)
Definition i7cor3t.F:40
i7sto
subroutine i7sto(j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, ifq, cand_a, cand_p, ifpen, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, nin, gap_s_l, gap_m_l, intth, drad, itied, cand_f, dgapload)
Definition i7sto.F:41
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