OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23sto.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i23sto (j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, msr, nsn, oldnum, nsnrold, cand_a, ifpen, cand_p)

Function/Subroutine Documentation

◆ i23sto()

subroutine i23sto ( integer j_stok,
integer, dimension(4,*) irect,
x,
integer, dimension(*) nsv,
integer ii_stok,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer mulnsn,
integer noint,
marge,
integer i_mem,
integer, dimension(mvsiz) prov_n,
integer, dimension(mvsiz) prov_e,
integer eshift,
integer inacti,
integer igap,
gap,
gap_s,
gap_m,
gapmin,
gapmax,
curv_max,
integer, dimension(*) msr,
integer nsn,
integer, dimension(*) oldnum,
integer nsnrold,
integer, dimension(*) cand_a,
integer, dimension(*) ifpen,
cand_p )

Definition at line 31 of file i23sto.F.

38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42#include "comlock.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER I_MEM, NSN,NSNROLD,IGAP
51 INTEGER J_STOK,MULNSN,NOINT,INACTI,ESHIFT
52 INTEGER IRECT(4,*),CAND_N(*),CAND_E(*),CAND_A(*),NSV(*),MSR(*)
53 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IFPEN(*), OLDNUM(*),II_STOK
54C REAL
55 my_real
56 . x(3,*), gap_s(*), gap_m(*),
57 . marge, gap, gapmin, gapmax, curv_max(*),
58 . cand_p(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,K_STOK,I_STOK,N,NE,J
63 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
64C REAL
65 my_real
66 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
67 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
68 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
69 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
70 . pene(mvsiz), gapv(mvsiz)
71C-----------------------------------------------
72 CALL i23cor3t(j_stok ,x ,irect ,prov_e ,
73 1 prov_n ,igap ,gap ,x1 ,x2 ,
74 2 x3 ,x4 ,y1 ,y2 ,y3 ,
75 3 y4 ,z1 ,z2 ,z3 ,z4 ,
76 4 xi ,yi ,zi ,ix1 ,ix2 ,
77 5 ix3 ,ix4 ,nsn ,gap_s ,gapv ,
78 6 gapmax ,gapmin,curv_max,nsv,msr ,
79 7 gap_m )
80C-----------------------------------------------
81 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
82 . x4 ,y1 ,y2 ,y3 ,y4 ,
83 . z1 ,z2 ,z3 ,z4 ,xi ,
84 . yi ,zi ,pene ,ix1 ,ix2 ,
85 . ix3 ,ix4 ,igap ,gap ,gapv )
86C-----------------------------------------------
87C REMOVAL OF OLD CANDIDATES ALREADY STORED (INITIAL PENETRATION)
88C-----------------------------------------------
89 DO i=1,j_stok
90 IF(pene(i)/=zero)THEN
91 n = prov_n(i)
92 ne = prov_e(i)+eshift
93 IF(n>nsn) THEN
94C Numbering of previous triangles for non-local nodes (SPMD)
95 n = oldnum(n-nsn)+nsn
96 IF(n==nsn) n = nsn+nsnrold+1
97 END IF
98 j = cand_a(n)
99 DO WHILE(j<=cand_a(n+1)-1)
100 IF(cand_e(j)==ne)THEN
101 pene(i)=zero
102 j=cand_a(n+1)
103 ELSE
104 j=j+1
105 ENDIF
106 ENDDO
107 ENDIF
108 ENDDO
109C-----------------------------------------------
110 k_stok = 0
111 DO i=1,j_stok
112 IF(pene(i)/=zero) k_stok = k_stok + 1
113 ENDDO
114 IF(k_stok==0)RETURN
115C
116#include "lockon.inc"
117 i_stok = ii_stok
118 IF(i_stok+k_stok>mulnsn) THEN
119 i_mem = 2
120#include "lockoff.inc"
121 RETURN
122 ENDIF
123 ii_stok = i_stok + k_stok
124#include "lockoff.inc"
125C-----------------------------------------------
126 DO i=1,j_stok
127 IF(pene(i)/=zero)THEN
128 i_stok = i_stok + 1
129 cand_n(i_stok) = prov_n(i)
130 cand_e(i_stok) = prov_e(i)+eshift
131 ifpen(i_stok) = 0
132 cand_p(i_stok) = zero
133 ENDIF
134 ENDDO
135 RETURN
136
137C To be redone
138c DO I=1,J_STOK
139c IF(PENE(I)/=ZERO)THEN
140c I_STOK = I_STOK + 1
141c CAND_N(I_STOK) = PROV_N(I)
142c CAND_E(I_STOK) = PROV_E(I)+ESHIFT
143cC
144c N = PROV_N(I)
145c NE = PROV_E(I)+ESHIFT
146c N1 = IRECTG(1,NE)
147c N2 = IRECTG(2,NE)
148c N3 = IRECTG(3,NE)
149c N4 = IRECTG(4,NE)
150c ITAGP(N1)=1
151c ITAGP(N2)=1
152c ITAGP(N3)=1
153c ITAGP(N4)=1
154c IF(N>NSN) THEN
155c This is sorted previously for non-local nodes (SPMD)
156c N = OLDNUM(N-NSN)+NSN
157c IF(N==NSN) N = NSN+NSNROLD+1
158c END IF
159c IFPEN(I_STOK) = 0
160c CAND_P(I_STOK) = ZERO
161cC
162cC look for a previous contact w/neighbour
163c J = CAND_A(N)
164c DO WHILE(J<=CAND_A(N+1)-1)
165c ME=CAND_E(J)
166c IF(ME/=NE)THEN
167c M1 = IRECTG(1,ME)
168c M2 = IRECTG(2,ME)
169c M3 = IRECTG(3,ME)
170c M4 = IRECTG(4,ME)
171c IF((ITAGP(M1)/=0.AND.ITAGP(M2)/=0).OR.
172c . (ITAGP(M2)/=0.AND.ITAGP(M3)/=0).OR.
173c . (M4/=M3.AND.ITAGP(M3)/=0.AND.ITAGP(M4)/=0).OR.
174c . (M4/=M3.AND.ITAGP(M4)/=0.AND.ITAGP(M1)/=0).OR.
175c . (M4==M3.AND.ITAGP(M3)/=0.AND.ITAGP(M1)/=0))THEN
176cC
177c Retains information from 1 neighbor only (1st penetrated)
178c It must be redone / sorted
179c IF(ABS(IFPEN(J)) > ABS(IFPEN(I_STOK)))THEN
180c IFPEN(I_STOK) = IFPEN(J)
181c CAND_P(I_STOK) = CAND_P(J)
182c END IF
183c ENDIF
184c J=J+1
185c END IF
186c ENDDO
187c ITAGP(N1)=0
188c ITAGP(N2)=0
189c ITAGP(N3)=0
190c ITAGP(N4)=0
191c ENDIF
192c ENDDO
193C-----------------------------------------------
194 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i23cor3t
subroutine i23cor3t(x, irect, nsv, cand_e, cand_n, gapv, igap, gap, gap_s, gapmin, gapmax, msr, gap_m, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi)
Definition i23cor3t.F:36
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