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