OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2cor3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i2cor3 ../starter/source/interfaces/inter3d1/i2cor3.F
25!||--- called by ------------------------------------------------------
26!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
27!|| i2tri ../starter/source/interfaces/inter3d1/i2tri.F
28!||--- calls -----------------------------------------------------
29!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.F
30!|| insol3 ../starter/source/interfaces/inter3d1/insol3.F
31!|| volint ../starter/source/interfaces/inter3d1/volint.F
32!||====================================================================
33 SUBROUTINE i2cor3(X ,IRECT ,NSV ,CAND_E ,CAND_N,
34 2 STF ,STFN ,GAPV ,IGAP ,GAP ,
35 3 GAP_S ,GAP_M ,ISTF ,NINT ,IXC ,
36 4 IXTG ,THK_PART,IPARTC,GEO , NOINT,
37 5 IXS ,IXS10 ,PM ,THK ,KNOD2ELS,
38 6 KNOD2ELC,KNOD2ELTG,NOD2ELS,NOD2ELC,NOD2ELTG,
39 7 IGNORE,IXS16 ,IXS20 ,IPARTTG,IGEO,DSEARCH ,
40 8 PM_STACK , IWORKSH ,IX1 ,IX2 ,
41 5 IX3 ,IX4 ,NSVG,X1 ,X2 ,
42 6 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
43 7 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
44 8 XI ,YI ,ZI ,STIF ,IFLAG )
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--
268 END
i2cor3
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)
Definition i2cor3.F:45
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