OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25sto_e2s.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!|| i25sto_e2s ../engine/source/interfaces/intsort/i25sto_e2s.F
25!||--- called by ------------------------------------------------------
26!|| i25trivox_edg ../engine/source/interfaces/intsort/i25trivox_edg.F
27!||--- calls -----------------------------------------------------
28!|| i25pen3_e2s ../engine/source/interfaces/intsort/i25pen3_e2s.F
29!||--- uses -----------------------------------------------------
30!|| tri25ebox ../engine/share/modules/tri25ebox.F
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i25sto_e2s(
34 1 J_STOK,IRECT ,X ,II_STOK,INACTI,
35 2 CAND_S,CAND_M ,MULNSN,NOINT ,MARGE,
36 3 I_MEM ,PROV_S ,PROV_M,IGAP0 ,CAND_A,
37 4 NEDGE ,LEDGE ,ITAB ,DRAD ,IGAP ,
38 5 GAP_M ,GAP_M_L,GAPE ,GAP_E_L,ADMSR,
39 6 EDG_BISECTOR,VTX_BISECTOR,CAND_P, PROV_IDS,
40 7 IFQ ,CAND_FX ,CAND_FY,CAND_FZ,IFPEN,
41 8 DGAPLOAD)
42C============================================================================
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE tri7box
47 USE tri25ebox
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.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"
57#include "assert.inc"
58#include "i25edge_c.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "units_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, INTENT(IN) :: PROV_IDS(2,NVSIZ)
69 INTEGER I_MEM, IGAP0, NEDGE, NIN, ITAB(*), INACTI,IFQ
70 INTEGER J_STOK,MULNSN,NOINT,IFORM,IGAP
71 INTEGER IRECT(4,*),LEDGE(NLEDGE,*),ADMSR(4,*),CAND_S(*),CAND_M(*),II_STOK,
72 . CAND_A(*),IFPEN(*)
73 INTEGER PROV_S(MVSIZ),PROV_M(MVSIZ)
74C REAL
75 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
76 my_real
77 . marge,x(3,*), gap_m(*), gap_m_l(*), gape(*), gap_e_l(*),
78 . cand_p(4,*),cand_fx(4,*) ,cand_fy(4,*),cand_fz(4,*)
79 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I,J,K_STOK,I_STOK,IAD0,IAD,IADFIN,N,NE,EJ
84 INTEGER I_STOK_FIRST,NINDX,INDEX(MVSIZ)
85C REAL
86 my_real
87 . pene(mvsiz)
88C-----------------------------------------------
89 CALL i25pen3_e2s( j_stok,prov_s ,prov_m ,drad ,igap0 ,
90 . nedge ,ledge ,marge ,gap_m ,gap_m_l ,
91 . gape ,gap_e_l ,igap ,x ,irect ,
92 . pene ,admsr ,edg_bisector ,vtx_bisector,itab,
93 . xrem_edge,e_rbuf_size,nedge_remote,dgapload)
94C-----------------------------------------------
95C SUPPRESSION DES ANCIENS CANDIDATS DEJA STOCKES (PENE INITIALE)
96C-----------------------------------------------
97C IF(INACTI==5)THEN
98 DO i=1,j_stok
99C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, PENE(I))
100
101 IF(pene(i)/=zero)THEN
102 n = prov_s(i)
103 ne = prov_m(i)
104
105C IF(N>NEDGE) THEN
106C numerotation tris precedent pour les noeuds non locaux (SPMD)
107C N = OLDNUM(N-NEDGE)+NEDGE
108C IF(N==NEDGE) N = NEDGE+NEDGEROLD+1
109C END IF
110
111C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, N)
112 IF(n>nedge) THEN
113C numerotation tris precedent pour les noeuds non locaux (SPMD)
114C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, OLDNUM_EDGE(N-NEDGE))
115 n = oldnum_edge(n-nedge)+nedge
116C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, N)
117 IF(n <= nedge) n = nedge+nedge_remote_old+1
118 END IF
119C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, N)
120
121 assert(n > 0)
122 j = cand_a(n)
123 DO WHILE(j<=cand_a(n+1)-1)
124 IF(cand_m(j)==ne)THEN
125 pene(i)=zero
126 j=cand_a(n+1)
127C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, J)
128 ELSE
129 j=j+1
130 ENDIF
131 ENDDO
132C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, PENE(I))
133
134 ENDIF
135 ENDDO
136C ENDIF
137C-----------------------------------------------
138 k_stok = 0
139 DO i=1,j_stok
140 IF(pene(i)/=zero) THEN
141 k_stok = k_stok + 1
142 END IF
143 ENDDO
144 IF(k_stok==0)RETURN
145C
146#include "lockon.inc"
147 i_stok = ii_stok
148 IF(i_stok+k_stok>mulnsn) THEN
149 i_mem = 2
150#include "lockoff.inc"
151 RETURN
152 ENDIF
153 ii_stok = i_stok + k_stok
154#include "lockoff.inc"
155C IF(INACTI==5)THEN
156 DO i=1,j_stok
157 debug_e2e(prov_ids(2,i)==d_es.AND.prov_ids(1,i)==d_em,pene(i))
158 IF(pene(i)/=zero)THEN
159 assert(prov_s(i) > 0)
160 assert(prov_s(i) <= nedge + nedge_remote)
161C DEBUG_E2E(PROV_IDS(2,I)==D_ES.AND.PROV_IDS(1,I)==D_EM, I_STOK)
162 i_stok = i_stok + 1
163 cand_s(i_stok) = prov_s(i)
164 cand_m(i_stok) = prov_m(i)
165 cand_p(1:4,i_stok) = zero
166 IF(ifq > 0) THEN
167 cand_fx(1:4,i_stok) = zero
168 cand_fy(1:4,i_stok) = zero
169 cand_fz(1:4,i_stok) = zero
170 ifpen(i_stok) = 0
171 ENDIF
172 ENDIF
173 debug_e2e(prov_ids(2,i)==d_es.AND.prov_ids(1,i)==d_em,cand_p(1,i_stok))
174 debug_e2e(prov_ids(2,i)==d_es.AND.prov_ids(1,i)==d_em,cand_p(2,i_stok))
175 debug_e2e(prov_ids(2,i)==d_es.AND.prov_ids(1,i)==d_em,cand_p(3,i_stok))
176 debug_e2e(prov_ids(2,i)==d_es.AND.prov_ids(1,i)==d_em,cand_p(4,i_stok))
177 ENDDO
178C ELSE
179C DO I=1,J_STOK
180C IF(PENE(I)/=ZERO)THEN
181C I_STOK = I_STOK + 1
182C CAND_S(I_STOK) = PROV_S(I)
183C CAND_M(I_STOK) = PROV_M(I)
184C ENDIF
185C ENDDO
186C END IF
187C-----------------------------------------------
188 RETURN
189 END
190
191
my_real
#define my_real
Definition cppsort.cpp:32
i25sto_e2s
subroutine i25sto_e2s(j_stok, irect, x, ii_stok, inacti, cand_s, cand_m, mulnsn, noint, marge, i_mem, prov_s, prov_m, igap0, cand_a, nedge, ledge, itab, drad, igap, gap_m, gap_m_l, gape, gap_e_l, admsr, edg_bisector, vtx_bisector, cand_p, prov_ids, ifq, cand_fx, cand_fy, cand_fz, ifpen, dgapload)
Definition i25sto_e2s.F:42
tri25ebox::nedge_remote
integer nedge_remote
Definition tri25ebox.F:73
tri25ebox::nedge_remote_old
integer nedge_remote_old
Definition tri25ebox.F:96
tri25ebox::oldnum_edge
integer, dimension(:), allocatable oldnum_edge
Definition tri25ebox.F:93
i25pen3_e2s
subroutine i25pen3_e2s(jlt, cand_s, cand_m, drad, igap0, nedge, ledge, marge, gap_m, gap_m_l, gape, gap_e_l, igap, x, irect, pene, admsr, edg_bisector, vtx_bisector, itab, dgapload)
Definition i25pen3_e2s.F:35