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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25sto_e2s()

subroutine i25sto_e2s ( 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,*) ledge,
integer, dimension(*) itab,
intent(in) drad,
integer igap,
gap_m,
gap_m_l,
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, dimension(2,nvsiz), intent(in) prov_ids,
integer ifq,
cand_fx,
cand_fy,
cand_fz,
integer, dimension(*) ifpen,
intent(in) dgapload )

Definition at line 33 of file i25sto_e2s.F.

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
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_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