OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3.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!|| i25cor3 ../starter/source/interfaces/inter3d1/i25cor3.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||====================================================================
28 SUBROUTINE i25cor3(
29 1 JLT ,IGAP ,X ,IRECT ,NSV ,
30 2 CAND_E ,CAND_N ,XI ,YI ,ZI ,
31 4 IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
32 5 NSN ,GAP_S ,GAPS ,ADMSR ,NOD_NORMAL ,
33 7 X1 ,X2 ,X3 ,X4 ,X0 ,
34 8 Y1 ,Y2 ,Y3 ,Y4 ,Y0 ,
35 9 Z1 ,Z2 ,Z3 ,Z4 ,Z0 ,
36 A NNX ,NNY ,NNZ ,MVOISIN,MVOISN ,
37 B GAP_M ,GAPM ,GAP_NM,GAPNM ,
38 C GAP_S_L ,GAP_M_L,GAPMXL,LBOUND,IBOUND )
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.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 IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
51 . JLT, NSN, IGAP
52 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
53 . NSVG(MVSIZ), ADMSR(4,*),
54 . MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ)
55 my_real
56 . X(3,*), GAP_S(*), GAPS(MVSIZ), GAP_M(*), GAPM(*),
57 . GAP_NM(4,*), GAPNM(4,*), GAP_S_L(*), GAP_M_L(*),
58 . GAPMXL(*)
59 my_real
60 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
61 . x1(mvsiz),y1(mvsiz),z1(mvsiz),
62 . x2(mvsiz),y2(mvsiz),z2(mvsiz),
63 . x3(mvsiz),y3(mvsiz),z3(mvsiz),
64 . x4(mvsiz),y4(mvsiz),z4(mvsiz),
65 . x0(mvsiz),y0(mvsiz),z0(mvsiz),
66 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
67 real*4 nod_normal(3,4,*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I ,J , L, NN, IG, JFT, IX, NI, I1, I2, I3, I4
72 my_real
73 . XN
74C-----------------------------------------------
75 DO I=1,jlt
76 ni = cand_n(i)
77C
78 ig = nsv(ni)
79 nsvg(i) = ig
80C
81 xi(i) = x(1,ig)
82 yi(i) = x(2,ig)
83 zi(i) = x(3,ig)
84 gaps(i) = gap_s(ni)
85C
86 END DO
87C
88 DO i=1,jlt
89C
90 l = cand_e(i)
91C
92 ix=irect(1,l)
93 ix1(i)=ix
94 x1(i)=x(1,ix)
95 y1(i)=x(2,ix)
96 z1(i)=x(3,ix)
97C
98 ix=irect(2,l)
99 ix2(i)=ix
100 x2(i)=x(1,ix)
101 y2(i)=x(2,ix)
102 z2(i)=x(3,ix)
103C
104 ix=irect(3,l)
105 ix3(i)=ix
106 x3(i)=x(1,ix)
107 y3(i)=x(2,ix)
108 z3(i)=x(3,ix)
109C
110 ix=irect(4,l)
111 ix4(i)=ix
112 x4(i)=x(1,ix)
113 y4(i)=x(2,ix)
114 z4(i)=x(3,ix)
115C
116 gapm(i) = gap_m(l)
117 gapnm(1:4,i)=gap_nm(1:4,l)
118C
119 END DO
120C
121 IF(igap/=3)THEN
122 gapmxl(1:jlt)=ep30
123 ELSE
124 DO i=1,jlt
125 ni = cand_n(i)
126 l = cand_e(i)
127 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
128 END DO
129 END IF
130C
131 DO i=1,jlt
132C
133 IF(ix3(i) /= ix4(i))THEN
134 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
135 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
136 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
137 ELSE
138 x0(i) = x3(i)
139 y0(i) = y3(i)
140 z0(i) = z3(i)
141 ENDIF
142C
143 END DO
144C
145 DO i=1,jlt
146C
147 l = cand_e(i)
148C
149 nnx(i,1)=nod_normal(1,1,l)
150 nny(i,1)=nod_normal(2,1,l)
151 nnz(i,1)=nod_normal(3,1,l)
152C
153 nnx(i,2)=nod_normal(1,2,l)
154 nny(i,2)=nod_normal(2,2,l)
155 nnz(i,2)=nod_normal(3,2,l)
156C
157 nnx(i,3)=nod_normal(1,3,l)
158 nny(i,3)=nod_normal(2,3,l)
159 nnz(i,3)=nod_normal(3,3,l)
160C
161 nnx(i,4)=nod_normal(1,4,l)
162 nny(i,4)=nod_normal(2,4,l)
163 nnz(i,4)=nod_normal(3,4,l)
164C
165 END DO
166C
167 DO i=1,jlt
168 IF(ix3(i)/=ix4(i))THEN
169 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
170 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
171 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
172 ELSE
173 nnx(i,5)=nnx(i,4)
174 nny(i,5)=nny(i,4)
175 nnz(i,5)=nnz(i,4)
176 ENDIF
177 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
178 nnx(i,5)=xn*nnx(i,5)
179 nny(i,5)=xn*nny(i,5)
180 nnz(i,5)=xn*nnz(i,5)
181 END DO
182C
183 ibound(1:4,1:jlt)=0
184 DO i=1,jlt
185 l = cand_e(i)
186 DO j=1,4
187 mvoisn(i,j)=mvoisin(j,l)
188 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
189 END DO
190 END DO
191C
192 RETURN
193 END
max
#define max(a, b)
Definition macros.h:21
i25cor3
subroutine i25cor3(jlt, igap, x, irect, nsv, cand_e, cand_n, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, gap_s, gaps, admsr, nod_normal, x1, x2, x3, x4, x0, y1, y2, y3, y4, y0, z1, z2, z3, z4, z0, nnx, nny, nnz, mvoisin, mvoisn, gap_m, gapm, gap_nm, gapnm, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
Definition i25cor3.F:39