OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7sto.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 i7sto (j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, ifq, cand_a, cand_p, ifpen, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, nin, gap_s_l, gap_m_l, intth, drad, itied, cand_f, dgapload)

Function/Subroutine Documentation

◆ i7sto()

subroutine i7sto ( 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 ifq,
integer, dimension(*) cand_a,
cand_p,
integer, dimension(*) ifpen,
integer nsn,
integer, dimension(*) oldnum,
integer nsnrold,
integer igap,
gap,
gap_s,
gap_m,
gapmin,
gapmax,
curv_max,
integer nin,
gap_s_l,
gap_m_l,
integer intth,
intent(in) drad,
integer itied,
cand_f,
intent(in) dgapload )

Definition at line 32 of file i7sto.F.

41C============================================================================
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER I_MEM, NSN, NSNROLD,IGAP,NIN,INTTH,ITIED
55 INTEGER J_STOK,MULNSN,NOINT,INACTI,IFQ,ESHIFT
56 INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_A(*)
57 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IFPEN(*), OLDNUM(*),
58 * II_STOK
59 my_real , INTENT(IN) :: drad,dgapload
61 . x(3,*), cand_p(*), gap_s(*), gap_m(*),
62 . marge, gap, gapmin, gapmax,curv_max(*),
63 . gap_s_l(*),gap_m_l(*), cand_f(8,*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I,K_STOK,I_STOK,N,NE,J,ITYPE
68 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
69C REAL
71 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
72 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
73 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
74 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
75 . pene(mvsiz), gapv(mvsiz)
76 DATA itype/7/
77C-----------------------------------------------
78 CALL i7cor3t(j_stok ,x ,irect ,nsv ,prov_e ,
79 1 prov_n ,igap ,gap ,x1 ,x2 ,
80 2 x3 ,x4 ,y1 ,y2 ,y3 ,
81 3 y4 ,z1 ,z2 ,z3 ,z4 ,
82 4 xi ,yi ,zi ,stif ,ix1 ,
83 5 ix2 ,ix3 ,ix4 ,nsn ,gap_s ,
84 6 gap_m ,gapv ,gapmax,gapmin,curv_max,
85 7 itype ,nin ,gap_s_l,gap_m_l,intth ,
86 8 drad ,dgapload)
87C-----------------------------------------------
88 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
89 . x4 ,y1 ,y2 ,y3 ,y4 ,
90 . z1 ,z2 ,z3 ,z4 ,xi ,
91 . yi ,zi ,pene ,ix1 ,ix2 ,
92 . ix3 ,ix4 ,igap ,gap ,gapv )
93C-----------------------------------------------
94C SUPPRESSION DES ANCIENS CANDIDATS DEJE STOCKES (PENE INITIALE)
95C-----------------------------------------------
96 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
97 . itied/=0)THEN
98 DO i=1,j_stok
99 IF(pene(i)/=zero)THEN
100 n = prov_n(i)
101 ne = prov_e(i)+eshift
102 IF(n>nsn) THEN
103C numerotation tris precedent pour les noeuds non locaux (SPMD)
104 n = oldnum(n-nsn)+nsn
105 IF(n==nsn) n = nsn+nsnrold+1
106 END IF
107 j = cand_a(n)
108 DO WHILE(j<=cand_a(n+1)-1)
109 IF(cand_e(j)==ne)THEN
110 pene(i)=zero
111 j=cand_a(n+1)
112 ELSE
113 j=j+1
114 ENDIF
115 ENDDO
116 ENDIF
117 ENDDO
118 ENDIF
119C-----------------------------------------------
120 k_stok = 0
121 DO i=1,j_stok
122 IF(pene(i)/=zero) k_stok = k_stok + 1
123 ENDDO
124 IF(k_stok==0)RETURN
125C
126#include "lockon.inc"
127 i_stok = ii_stok
128 IF(i_stok+k_stok>mulnsn) THEN
129 i_mem = 2
130#include "lockoff.inc"
131 RETURN
132 ENDIF
133 ii_stok = i_stok + k_stok
134#include "lockoff.inc"
135C-----------------------------------------------
136 IF(ifq > 0 .AND.
137 . (inacti == 5 .OR. inacti ==6 .OR. inacti ==7).AND.itied /=0)THEN
138 DO i=1,j_stok
139 IF(pene(i)/=zero)THEN
140 i_stok = i_stok + 1
141 cand_n(i_stok) = prov_n(i)
142 cand_e(i_stok) = prov_e(i)+eshift
143 ifpen(i_stok) = 0
144 cand_p(i_stok) = zero
145 cand_f(1:8,i_stok)=zero
146 ENDIF
147 ENDDO
148 ELSEIF(ifq > 0 .AND.
149 . (inacti == 5 .OR. inacti ==6 .OR. inacti ==7))THEN
150 DO i=1,j_stok
151 IF(pene(i)/=0.0)THEN
152 i_stok = i_stok + 1
153 cand_n(i_stok) = prov_n(i)
154 cand_e(i_stok) = prov_e(i)+eshift
155 ifpen(i_stok) = 0
156 cand_p(i_stok) = zero
157 ENDIF
158 ENDDO
159 ELSEIF(ifq > 0..AND. itied /=0)THEN
160 DO i=1,j_stok
161 IF(pene(i)/=zero)THEN
162 i_stok = i_stok + 1
163 cand_n(i_stok) = prov_n(i)
164 cand_e(i_stok) = prov_e(i)+eshift
165 ifpen(i_stok) = 0
166 cand_f(1:8,i_stok)=zero
167 ENDIF
168 ENDDO
169 ELSEIF(ifq > 0)THEN
170 DO i=1,j_stok
171 IF(pene(i)/=zero)THEN
172 i_stok = i_stok + 1
173 cand_n(i_stok) = prov_n(i)
174 cand_e(i_stok) = prov_e(i)+eshift
175 ifpen(i_stok) = 0
176 ENDIF
177 ENDDO
178 ELSEIF((inacti==5.OR.inacti==6.OR.inacti==7).AND.itied /= 0)THEN
179 DO i=1,j_stok
180 IF(pene(i)/=zero)THEN
181 i_stok = i_stok + 1
182 cand_n(i_stok) = prov_n(i)
183 cand_e(i_stok) = prov_e(i)+eshift
184 cand_p(i_stok) = zero
185 cand_f(1:8,i_stok)=zero
186 ENDIF
187 ENDDO
188 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
189 DO i=1,j_stok
190 IF(pene(i)/=zero)THEN
191 i_stok = i_stok + 1
192 cand_n(i_stok) = prov_n(i)
193 cand_e(i_stok) = prov_e(i)+eshift
194 cand_p(i_stok) = zero
195 ENDIF
196 ENDDO
197 ELSEIF(itied /= 0)THEN
198 DO i=1,j_stok
199 IF(pene(i)/=zero)THEN
200 i_stok = i_stok + 1
201 cand_n(i_stok) = prov_n(i)
202 cand_e(i_stok) = prov_e(i)+eshift
203 cand_f(1:8,i_stok)=zero
204 ENDIF
205 ENDDO
206 ELSE
207 DO i=1,j_stok
208 IF(pene(i)/=zero)THEN
209 i_stok = i_stok + 1
210 cand_n(i_stok) = prov_n(i)
211 cand_e(i_stok) = prov_e(i)+eshift
212 ENDIF
213 ENDDO
214 ENDIF
215C-----------------------------------------------
216 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine i7cor3t(jlt, x, irect, nsv, cand_e, cand_n, igap, gap, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsn, gap_s, gap_m, gapv, gapmax, gapmin, curv_max, ityp, nin, gap_s_l, gap_m_l, intth, drad, dgapload)
Definition i7cor3t.F:40
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