OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25sto_edg.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "assert.inc"
#include "i25edge_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25sto_edg()

subroutine i25sto_edg ( integer j_stok,
integer, dimension(4,*) irect,
x,
integer ii_stok,
integer inacti,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
integer mulnsn,
integer noint,
marge,
integer i_mem,
integer, dimension(mvsiz) prov_s,
integer, dimension(mvsiz) prov_m,
integer igap0,
integer, dimension(*) cand_a,
integer nedge,
integer, dimension(nledge,nedge) ledge,
integer, dimension(numnod) itab,
intent(in) drad,
integer igap,
gape,
gap_e_l,
integer, dimension(4,*) admsr,
real*4, dimension(3,4,*) edg_bisector,
real*4, dimension(3,2,*) vtx_bisector,
cand_p,
integer ifq,
cand_fx,
cand_fy,
cand_fz,
integer, dimension(*) ifpen,
intent(in) dgapload )

Definition at line 33 of file i25sto_edg.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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