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!|| i2trivox ../starter/source/interfaces/inter3d1/i2trivox.F90
27!||--- calls -----------------------------------------------------
28!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.F
29!|| insol3 ../starter/source/interfaces/inter3d1/insol3.F
30!|| volint ../starter/source/interfaces/inter3d1/volint.F
31!||--- uses -----------------------------------------------------
32!||====================================================================
33 SUBROUTINE i2cor3(X ,IRECT ,NSV ,CAND_E ,CAND_N,
34 2 GAPV ,IGAP ,GAP ,first,last,
35 3 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 ,gapmin,gapmax)
45C============================================================================
46 use element_mod , only :nixs,nixc,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IGAP, IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
59 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),NOINT,
60 . IXS(NIXS,*), IXS10(*),KNOD2ELS(*),
61 . KNOD2ELC(*),KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
62 . NOD2ELTG(*),NINT,IGNORE,
63 . IXS16(*), IXS20(*),IPARTTG(*),IGEO(NPROPGI,*),
64 . IWORKSH(*)
65 integer, intent(in) :: first !< first index of the candidates
66 integer, intent(in) :: last !< last index of the candidates
67C REAL
68 my_real
69 . gap, x(3,*), gapv(*),
70 . geo(npropg,*),thk(*),thk_part(*),pm(*),dsearch,pm_stack(*)
71 my_real, intent(inout) :: gapmin,gapmax
72 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
76 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: xi,yi,zi
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com04_c.inc"
81#include "param_c.inc"
82#include "scr08_c.inc"
83#include "vect07_c.inc"
84#include "units_c.inc"
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I, L, NN, IG,NODE1,NODE2,NODE3,NODE4,II,IAD,JJ,JJJ,
89 . IEL,MG,IP,NELS,NELC,NELTG
90C REAL
91 my_real
92 . THKSECND,THKMAIN,DD,DX1,DY1,DZ1,DX3,DY3,DZ3,VOL,AREA
93C-----------------------------------------------
94C
95 DO I=first,last
96 ig = nsv(cand_n(i))
97 nsvg(i) = ig
98 xi(i) = x(1,ig)
99 yi(i) = x(2,ig)
100 zi(i) = x(3,ig)
101 ENDDO
102C
103 IF(igap==0 .AND. ignore <= 1)THEN
104 DO i=first,last
105 gapv(i) = gap
106 ENDDO
107 ELSEIF((ignore == 2 .OR. ignore == 3) .AND. dsearch /= zero)THEN
108 DO i=first,last
109 gapv(i) = gap
110 ENDDO
111 ELSEIF(ignore >= 2)THEN
112 DO i=first,last
113 thksecnd = zero
114 thkmain = zero
115 ii=cand_n(i)
116 DO iad = knod2elc(nsvg(i))+1,knod2elc(nsvg(i)+1)
117 iel = nod2elc(iad)
118 mg=ixc(6,iel)
119 ip = ipartc(iel)
120 IF ( thk_part(ip) /= zero) THEN
121 thksecnd = thk_part(ip)
122 ELSEIF ( thk(iel) /= zero) THEN
123 thksecnd = thk(iel)
124 ELSE
125 thksecnd = geo(1,mg)
126 ENDIF
127 ENDDO
128C- 3N coats
129 DO iad = knod2eltg(nsvg(i))+1,knod2eltg(nsvg(i)+1)
130 iel = nod2eltg(iad)
131 mg=ixtg(5,iel)
132 ip = iparttg(iel)
133 IF ( thk_part(ip) /= zero) THEN
134 thksecnd = thk_part(ip)
135 ELSEIF ( thk(numelc+iel) /= zero) THEN
136 thksecnd = thk(numelc+iel)
137 ELSE
138 thksecnd = geo(1,mg)
139 ENDIF
140 ENDDO
141 nels = 0
142 nelc = 0
143 neltg = 0
144 CALL insol3(x,irect,ixs,nint,nels,cand_e(i),
145 . area,noint,knod2els ,nod2els ,0 ,ixs10,
146 . ixs16,ixs20)
147 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
148 . neltg,cand_e(i),geo ,pm ,knod2elc ,
149 . knod2eltg ,nod2elc ,nod2eltg,thk,2,igeo,
150 . pm_stack , iworksh )
151 IF(neltg/=0) THEN
152 mg=ixtg(5,neltg)
153 ip = iparttg(neltg)
154 IF ( thk_part(ip) /= zero) THEN
155 thkmain = thk_part(ip)
156 ELSEIF ( thk(numelc+neltg) /= zero) THEN
157 thkmain = thk(numelc+neltg)
158 ELSE
159 thkmain = geo(1,mg)
160 ENDIF
161 ELSEIF(nelc/=0) THEN
162 mg=ixc(6,nelc)
163 ip = ipartc(nelc)
164 IF ( thk_part(ip) /= zero) THEN
165 thkmain = thk_part(ip)
166 ELSEIF ( thk(nelc) /= zero) THEN
167 thkmain = thk(nelc)
168 ELSE
169 thkmain = geo(1,mg)
170 ENDIF
171 ELSEIF(nels/=0 .AND. nels <= numels8 .AND. ignore == 2) THEN
172 DO jj=1,8
173 jjj=ixs(jj+1,nels)
174 xc(jj)=x(1,jjj)
175 yc(jj)=x(2,jjj)
176 zc(jj)=x(3,jjj)
177 END DO
178 CALL volint(vol)
179C
180 thkmain = vol/area
181 ENDIF
182 dd = zero
183 node1=irect(1,cand_e(i))
184 node2=irect(2,cand_e(i))
185 node3=irect(3,cand_e(i))
186 node4=irect(4,cand_e(i))
187C LONGUEUR DIAG 1
188 dx1=(x(1,node1)-x(1,node3))
189 dy1=(x(2,node1)-x(2,node3))
190 dz1=(x(3,node1)-x(3,node3))
191 dd=sqrt(dx1**2+dy1**2+dz1**2)
192C LONGUEUR DIAG 2
193 dx3=(x(1,node2)-x(1,node4))
194 dy3=(x(2,node2)-x(2,node4))
195 dz3=(x(3,node2)-x(3,node4))
196 dd=min(dd,sqrt(dx3**2+dy3**2+dz3**2))
197 gapv(i) = max(zep05*dd,zep6*(thksecnd+thkmain))
198 gapmin = min(gapmin,gapv(i))
199 gapmax = max(gapmax,gapv(i))
200 ENDDO
201 ENDIF
202C
203 DO i=first,last
204C
205 l = cand_e(i)
206C
207 ix1(i)=irect(1,l)
208 ix2(i)=irect(2,l)
209 ix3(i)=irect(3,l)
210 ix4(i)=irect(4,l)
211C
212 ENDDO
213C
214 DO i=first,last
215C
216 nn=ix1(i)
217 x1(i)=x(1,nn)
218 y1(i)=x(2,nn)
219 z1(i)=x(3,nn)
220C
221 nn=ix2(i)
222 x2(i)=x(1,nn)
223 y2(i)=x(2,nn)
224 z2(i)=x(3,nn)
225C
226 nn=ix3(i)
227 x3(i)=x(1,nn)
228 y3(i)=x(2,nn)
229 z3(i)=x(3,nn)
230C
231 nn=ix4(i)
232 x4(i)=x(1,nn)
233 y4(i)=x(2,nn)
234 z4(i)=x(3,nn)
235C
236 ENDDO
237C
238 RETURN
239 END
i2cor3
subroutine i2cor3(x, irect, nsv, cand_e, cand_n, gapv, igap, gap, first, last, 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, gapmin, gapmax)
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:46
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:44
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