OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22err3.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!|| i22err3 ../starter/source/interfaces/inter3d1/i22err3.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| loi_fluid ../starter/source/fluid/loi_fluid.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE i22err3(
34 1 X ,NRTM ,IRECT ,ITAB ,
35 2 PM ,IXS ,NBRIC ,BRICS ,
36 3 ID,TITR,
37 4 IX1 ,IX2 ,IX3 ,IX4 ,X1 ,
38 5 X2 ,X3 ,X4 ,Y1 ,Y2 ,
39 6 Y3 ,Y4 ,Z1 ,Z2 ,Z3 ,
40 7 Z4 ,N1 ,N2 ,N3 ,X0 ,
41 8 Y0 ,Z0 ,XN1 ,YN1 ,ZN1 ,
42 9 XN2 ,YN2 ,ZN2 ,XN3 ,YN3 ,
43 1 ZN3 ,XN4 ,YN4 ,ZN4 )
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
50 use element_mod , only :nixs
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "param_c.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "inter22.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER :: NRTM, IRECT(4,*), ITAB(*), NBRIC, IXS(NIXS,*), BRICS(*)
68 my_real :: X(3,*), PM(NPROPM,*)
69 INTEGER :: ID, IMESG
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: N1,N2,N3
76 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X0,Y0,Z0
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn1,yn1,zn1
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn2,yn2,zn2
79 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn3,yn3,zn3
80 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn4,yn4,zn4
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I, J, IDEB, ILAW, MID, IBRIC, I22LAW06
85 my_real :: an
86 my_real, DIMENSION(MVSIZ) :: xx1,yy1,zz1
87 my_real, DIMENSION(MVSIZ) :: xx2,yy2,zz2
88 my_real, DIMENSION(MVSIZ) :: xx3,yy3,zz3
89 my_real, DIMENSION(MVSIZ) :: xx4,yy4,zz4
90 LOGICAL LOI_FLUID
91 EXTERNAL LOI_FLUID
92C-----------------------------------------------
93C #######################################################
94C # CHECKING DEGENERATED ELEMENTS IN LAGRAGIAN SIDE ##
95C #######################################################
96 ideb=0
97 DO WHILE(ideb<nrtm)
98C
99 !NRTM: Number of main faces
100 DO i=1,min(mvsiz,nrtm-ideb)
101 j=ideb+i
102 ix1(i)=irect(1,j)
103 ix2(i)=irect(2,j)
104 ix3(i)=irect(3,j)
105 ix4(i)=irect(4,j)
106 x1(i) =x(1,ix1(i))
107 y1(i) =x(2,ix1(i))
108 z1(i) =x(3,ix1(i))
109 x2(i) =x(1,ix2(i))
110 y2(i) =x(2,ix2(i))
111 z2(i) =x(3,ix2(i))
112 x3(i) =x(1,ix3(i))
113 y3(i) =x(2,ix3(i))
114 z3(i) =x(3,ix3(i))
115 x4(i) =x(1,ix4(i))
116 y4(i) =x(2,ix4(i))
117 z4(i) =x(3,ix4(i))
118 ENDDO
119C
120 DO i=1,min(mvsiz,nrtm-ideb)
121 !calculation of the center of gravity
122 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
123 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
124 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
125C
126 !Changement d'origine
127 xx1(i) = x1(i)-x0(i)
128 xx2(i) = x2(i)-x0(i)
129 xx3(i) = x3(i)-x0(i)
130 xx4(i) = x4(i)-x0(i)
131 yy1(i) = y1(i)-y0(i)
132 yy2(i) = y2(i)-y0(i)
133 yy3(i) = y3(i)-y0(i)
134 yy4(i) = y4(i)-y0(i)
135 zz1(i) = z1(i)-z0(i)
136 zz2(i) = z2(i)-z0(i)
137 zz3(i) = z3(i)-z0(i)
138 zz4(i) = z4(i)-z0(i)
139 ENDDO
140C
141 !decomposition of the shell into 4 triangles and calculation of areas
142 !If the area of two triangles having in common only a summit
143 ! (A12 and A34 for example) is zero then A_total=0 => dim=1
144 DO i=1,min(mvsiz,nrtm-ideb)
145 xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
146 yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
147 zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
148 n1(i)=xn1(i)
149 n2(i)=yn1(i)
150 n3(i)=zn1(i)
151 ENDDO
152C
153 DO i=1,min(mvsiz,nrtm-ideb)
154 xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
155 yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
156 zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
157 n1(i)=n1(i)+xn2(i)
158 n2(i)=n2(i)+yn2(i)
159 n3(i)=n3(i)+zn2(i)
160 ENDDO
161C
162 DO i=1,min(mvsiz,nrtm-ideb)
163 IF(ix3(i)/=ix4(i)) THEN
164 xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
165 yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
166 zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
167 n1(i)=n1(i)+xn3(i)
168 n2(i)=n2(i)+yn3(i)
169 n3(i)=n3(i)+zn3(i)
170 ELSE
171 xn3(i)=zero
172 yn3(i)=zero
173 zn3(i)=zero
174 ENDIF
175 ENDDO
176C
177 DO i=1,min(mvsiz,nrtm-ideb)
178 xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
179 yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
180 zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
181 n1(i)=n1(i)+xn4(i)
182 n2(i)=n2(i)+yn4(i)
183 n3(i)=n3(i)+zn4(i)
184 ENDDO
185C
186 DO i=1,min(mvsiz,nrtm-ideb)
187 an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
188 n1(i)=n1(i)/an
189 n2(i)=n2(i)/an
190 n3(i)=n3(i)/an
191 ENDDO
192C
193 DO i=1,min(mvsiz,nrtm-ideb)
194 x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
195 z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
196C
197 ! Si element d
198 IF(z0(i)==zero.AND.x0(i)==zero)THEN
199 CALL ancmsg(msgid=558,
200 . msgtype=msgerror,
201 . anmode=aninfo_blind_1,
202 . i1=id,
203 . c1=titr,
204 . i2=itab(ix1(i)),
205 . i3=itab(ix2(i)),
206 . i4=itab(ix3(i)),
207 . i5=itab(ix4(i)))
208 ENDIF
209 ENDDO
210C
211 ideb=ideb+min(mvsiz,nrtm-ideb)
212 ENDDO
213C
214C #######################################################
215
216
217
218
219
220C #######################################################
221C # CHECKING MATERIAL TYPE IN ALE SIDE ##
222C #######################################################
223 imesg = 0
224 DO i=1,nbric
225 ibric = brics(i)
226 mid = ixs(1,ibric)
227 ilaw = nint(pm(19,mid))
228 i22law06 = 0
229 i22law37 = 0
230 i22law51 = 0
231 IF(ilaw == 37) i22law37 = 5 ! UVAR buffer size
232 IF(ilaw == 51) i22law51 = m51_n0phas+4*m51_nvphas ! UVAR buffer size
233
234 IF((ilaw/=0).AND.(ilaw/=11).AND.(ilaw/=51).AND.(ilaw/=6).AND.(ilaw/=37))THEN
235 imesg = 97
236 EXIT
237 END IF
238 END do! next I
239
240 IF(i22law06*i22law37/=0 .OR. i22law06*i22law51/=0 .OR. i22law37*i22law51/=0 )THEN
241 imesg = 91
242 ENDIF
243
244 IF(imesg/=0)THEN
245 CALL ancmsg(msgid = imesg,
246 . msgtype = msgerror,
247 . anmode = aninfo_blind_1,
248 . i1 = id,
249 . c1 = titr)
250 ENDIF
251C #######################################################
252
253
254
255
256 RETURN
257 END
i22err3
subroutine i22err3(x, nrtm, irect, itab, pm, ixs, nbric, brics, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, n1, n2, n3, x0, y0, z0, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4)
Definition i22err3.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895