OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr08_c.inc"
#include "vect07_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2cor3 (x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ignore, ixs16, ixs20, iparttg, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, iflag)

Function/Subroutine Documentation

◆ i2cor3()

subroutine i2cor3 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfn,
gapv,
integer igap,
gap,
gap_s,
gap_m,
integer istf,
integer nint,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
thk_part,
integer, dimension(*) ipartc,
geo,
integer noint,
integer, dimension(nixs,*) ixs,
integer, dimension(*) ixs10,
pm,
thk,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
integer ignore,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer, dimension(*) iparttg,
integer, dimension(npropgi,*) igeo,
dsearch,
pm_stack,
integer, dimension(*) iworksh,
integer, dimension(mvsiz), intent(inout) ix1,
integer, dimension(mvsiz), intent(inout) ix2,
integer, dimension(mvsiz), intent(inout) ix3,
integer, dimension(mvsiz), intent(inout) ix4,
integer, dimension(mvsiz), intent(inout) nsvg,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(out) xi,
intent(out) yi,
intent(out) zi,
intent(inout) stif,
integer, intent(in) iflag )

Definition at line 33 of file i2cor3.F.

45C============================================================================
46C cette routine est appelee par : I7BUC1(/inter3d1/i7buc1.F)
47C I7TRI(/inter3d1/i7tri.F)
48C I2TRI(/inter3d1/i2tri.F)
49C I2BUC1(/inter3d1/i2buc1.F)
50C ININT3(/inter3d1/inint3.F)
51C----------------------------------------------------------------------------
52C cette routine appelle : -
53C============================================================================
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER IGAP, IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),ISTF,
66 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),NOINT,
67 . IXS(NIXS,*), IXS10(*),KNOD2ELS(*),
68 . KNOD2ELC(*),KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
69 . NOD2ELTG(*),NINT,IGNORE,
70 . IXS16(*), IXS20(*),IPARTTG(*),IGEO(NPROPGI,*),
71 . IWORKSH(*)
72 INTEGER, INTENT(IN) :: IFLAG
73C REAL
74 my_real
75 . gap, x(3,*), stf(*), stfn(*), gapv(*), gap_s(*), gap_m(*),
76 . geo(npropg,*),thk(*),thk_part(*),pm(*),dsearch,pm_stack(*)
77 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
79 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
80 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
81 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: xi,yi,zi
82 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: stif
83C-----------------------------------------------
84C C o m m o n B l o c k s
85C-----------------------------------------------
86#include "com04_c.inc"
87#include "param_c.inc"
88#include "scr08_c.inc"
89#include "vect07_c.inc"
90#include "units_c.inc"
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER I, IL, L, NN, IG,NODE1,NODE2,NODE3,NODE4,II,IAD,JJ,JJJ,
95 . IEL,MG,IP,NELS,NELC,NELTG
96C REAL
97 my_real
98 . thksecnd,thkmain,dd,dx1,dy1,dz1,dx3,dy3,dz3,vol,area,gapmin,gapmax
99C-----------------------------------------------
100C
101 DO i=lft,llt
102 ig = nsv(cand_n(i))
103 nsvg(i) = ig
104 xi(i) = x(1,ig)
105 yi(i) = x(2,ig)
106 zi(i) = x(3,ig)
107 ENDDO
108C
109 gapmin = ep30
110 gapmax = zero
111 IF(igap==0 .AND. ignore <= 1)THEN
112 DO i=lft,llt
113 gapv(i) = gap
114 ENDDO
115 IF(iflag==1) WRITE(iout,2001) gap
116 ELSEIF((ignore == 2 .OR. ignore == 3) .AND. dsearch /= zero)THEN
117 DO i=lft,llt
118 gapv(i) = gap
119 ENDDO
120 IF(iflag==1) WRITE(iout,2001) gap
121 ELSEIF(ignore >= 2)THEN
122 DO i=lft,llt
123 thksecnd = zero
124 thkmain = zero
125 ii=cand_n(i)
126 DO iad = knod2elc(nsvg(i))+1,knod2elc(nsvg(i)+1)
127 iel = nod2elc(iad)
128 mg=ixc(6,iel)
129 ip = ipartc(iel)
130 IF ( thk_part(ip) /= zero) THEN
131 thksecnd = thk_part(ip)
132 ELSEIF ( thk(iel) /= zero) THEN
133 thksecnd = thk(iel)
134 ELSE
135 thksecnd = geo(1,mg)
136 ENDIF
137 ENDDO
138C-- Cooques 3n
139 DO iad = knod2eltg(nsvg(i))+1,knod2eltg(nsvg(i)+1)
140 iel = nod2eltg(iad)
141 mg=ixtg(5,iel)
142 ip = iparttg(iel)
143 IF ( thk_part(ip) /= zero) THEN
144 thksecnd = thk_part(ip)
145 ELSEIF ( thk(numelc+iel) /= zero) THEN
146 thksecnd = thk(numelc+iel)
147 ELSE
148 thksecnd = geo(1,mg)
149 ENDIF
150 ENDDO
151 nels = 0
152 nelc = 0
153 neltg = 0
154 CALL insol3(x,irect,ixs,nint,nels,cand_e(i),
155 . area,noint,knod2els ,nod2els ,0 ,ixs10,
156 . ixs16,ixs20)
157 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
158 . neltg,cand_e(i),geo ,pm ,knod2elc ,
159 . knod2eltg ,nod2elc ,nod2eltg,thk,2,igeo,
160 . pm_stack , iworksh )
161 IF(neltg/=0) THEN
162 mg=ixtg(5,neltg)
163 ip = iparttg(neltg)
164 IF ( thk_part(ip) /= zero) THEN
165 thkmain = thk_part(ip)
166 ELSEIF ( thk(numelc+neltg) /= zero) THEN
167 thkmain = thk(numelc+neltg)
168 ELSE
169 thkmain = geo(1,mg)
170 ENDIF
171 ELSEIF(nelc/=0) THEN
172 mg=ixc(6,nelc)
173 ip = ipartc(nelc)
174 IF ( thk_part(ip) /= zero) THEN
175 thkmain = thk_part(ip)
176 ELSEIF ( thk(nelc) /= zero) THEN
177 thkmain = thk(nelc)
178 ELSE
179 thkmain = geo(1,mg)
180 ENDIF
181 ELSEIF(nels/=0 .AND. nels <= numels8 .AND. ignore == 2) THEN
182 DO jj=1,8
183 jjj=ixs(jj+1,nels)
184 xc(jj)=x(1,jjj)
185 yc(jj)=x(2,jjj)
186 zc(jj)=x(3,jjj)
187 END DO
188 CALL volint(vol)
189C
190 thkmain = vol/area
191 ENDIF
192 dd = zero
193 node1=irect(1,cand_e(i))
194 node2=irect(2,cand_e(i))
195 node3=irect(3,cand_e(i))
196 node4=irect(4,cand_e(i))
197C LONGUEUR DIAG 1
198 dx1=(x(1,node1)-x(1,node3))
199 dy1=(x(2,node1)-x(2,node3))
200 dz1=(x(3,node1)-x(3,node3))
201 dd=sqrt(dx1**2+dy1**2+dz1**2)
202C LONGUEUR DIAG 2
203 dx3=(x(1,node2)-x(1,node4))
204 dy3=(x(2,node2)-x(2,node4))
205 dz3=(x(3,node2)-x(3,node4))
206 dd=min(dd,sqrt(dx3**2+dy3**2+dz3**2))
207 gapv(i) = max(zep05*dd,zep6*(thksecnd+thkmain))
208 gapmin = min(gapmin,gapv(i))
209 gapmax = max(gapmax,gapv(i))
210 ENDDO
211 IF(iflag==1) WRITE(iout,2002) gapmin,gapmax
212 ELSE
213 DO i=lft,llt
214 gapv(i) = gap_s(cand_n(i))+gap_m(cand_e(i))
215 gapv(i) = max(gap,gapv(i))
216 gapmin = min(gapmin,gapv(i))
217 gapmax = max(gapmax,gapv(i))
218 ENDDO
219 IF(iflag==1) WRITE(iout,2002) gapmin,gapmax
220 ENDIF
221C
222 IF(istf/=0)THEN
223 DO i=lft,llt
224 stif(i)=stf(cand_e(i))*stfn(cand_n(i))
225 ENDDO
226 ENDIF
227C
228 DO i=lft,llt
229C
230 l = cand_e(i)
231C
232 ix1(i)=irect(1,l)
233 ix2(i)=irect(2,l)
234 ix3(i)=irect(3,l)
235 ix4(i)=irect(4,l)
236C
237 ENDDO
238C
239 DO i=lft,llt
240C
241 nn=ix1(i)
242 x1(i)=x(1,nn)
243 y1(i)=x(2,nn)
244 z1(i)=x(3,nn)
245C
246 nn=ix2(i)
247 x2(i)=x(1,nn)
248 y2(i)=x(2,nn)
249 z2(i)=x(3,nn)
250C
251 nn=ix3(i)
252 x3(i)=x(1,nn)
253 y3(i)=x(2,nn)
254 z3(i)=x(3,nn)
255C
256 nn=ix4(i)
257 x4(i)=x(1,nn)
258 y4(i)=x(2,nn)
259 z4(i)=x(3,nn)
260C
261 ENDDO
262C
263 RETURN
264C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
265 2001 FORMAT(//,1x,'SEARCH DISTANCE . . . . . . . . . . . . . .',1pg20.13/)
266 2002 FORMAT(//,1x,'SEARCH DISTANCE . . . . . . . . . . . . . .BETWEEN',1pg20.13,' AND ',1pg20.13/)
267C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:45
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
volint
subroutine volint(vol)
Definition volint.F:38