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
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "inter22.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER :: NRTM, IRECT(4,*), NOINT, ITAB(*), NBRIC, IXS(NIXS,*), BRICS(*)
67 my_real :: X(3,*), PM(NPROPM,*)
68 INTEGER :: ID, IMESG
69 CHARACTER(LEN=NCHARTITLE) :: TITR
70 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4
71 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: N1,N2,N3
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X0,Y0,Z0
76 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn1,yn1,zn1
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn2,yn2,zn2
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn3,yn3,zn3
79 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn4,yn4,zn4
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I, J, IDEB, ILAW, MID, IBRIC, JALE, JEUL, I22LAW06
84 my_real :: an
85 my_real, DIMENSION(MVSIZ) :: xx1,yy1,zz1
86 my_real, DIMENSION(MVSIZ) :: xx2,yy2,zz2
87 my_real, DIMENSION(MVSIZ) :: xx3,yy3,zz3
88 my_real, DIMENSION(MVSIZ) :: xx4,yy4,zz4
89 LOGICAL LOI_FLUID
90 EXTERNAL LOI_FLUID
91C-----------------------------------------------
92C #######################################################
93C # CHECKING DEGENERATED ELEMENTS IN LAGRAGIAN SIDE ##
94C #######################################################
95 ideb=0
96 DO WHILE(ideb<nrtm)
97C
98 !NRTM : nombre de faces mains
99 DO i=1,min(mvsiz,nrtm-ideb)
100 j=ideb+i
101 ix1(i)=irect(1,j)
102 ix2(i)=irect(2,j)
103 ix3(i)=irect(3,j)
104 ix4(i)=irect(4,j)
105 x1(i) =x(1,ix1(i))
106 y1(i) =x(2,ix1(i))
107 z1(i) =x(3,ix1(i))
108 x2(i) =x(1,ix2(i))
109 y2(i) =x(2,ix2(i))
110 z2(i) =x(3,ix2(i))
111 x3(i) =x(1,ix3(i))
112 y3(i) =x(2,ix3(i))
113 z3(i) =x(3,ix3(i))
114 x4(i) =x(1,ix4(i))
115 y4(i) =x(2,ix4(i))
116 z4(i) =x(3,ix4(i))
117 ENDDO
118C
119 DO i=1,min(mvsiz,nrtm-ideb)
120 !Calcul du centre de gravit
121 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
122 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
123 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
124C
125 !Changement d'origine
126 xx1(i) = x1(i)-x0(i)
127 xx2(i) = x2(i)-x0(i)
128 xx3(i) = x3(i)-x0(i)
129 xx4(i) = x4(i)-x0(i)
130 yy1(i) = y1(i)-y0(i)
131 yy2(i) = y2(i)-y0(i)
132 yy3(i) = y3(i)-y0(i)
133 yy4(i) = y4(i)-y0(i)
134 zz1(i) = z1(i)-z0(i)
135 zz2(i) = z2(i)-z0(i)
136 zz3(i) = z3(i)-z0(i)
137 zz4(i) = z4(i)-z0(i)
138 ENDDO
139C
140 !Decomposition de la coque en 4 triangles et calculs des aires
141 !Si l'aire de deux tirangles ayant en commun uniquement un sommet
142 ! (A12 et A34 par exemple) est nulle alors A_total=0 => dim=1
143 DO i=1,min(mvsiz,nrtm-ideb)
144 xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
145 yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
146 zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
147 n1(i)=xn1(i)
148 n2(i)=yn1(i)
149 n3(i)=zn1(i)
150 ENDDO
151C
152 DO i=1,min(mvsiz,nrtm-ideb)
153 xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
154 yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
155 zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
156 n1(i)=n1(i)+xn2(i)
157 n2(i)=n2(i)+yn2(i)
158 n3(i)=n3(i)+zn2(i)
159 ENDDO
160C
161 DO i=1,min(mvsiz,nrtm-ideb)
162 IF(ix3(i)/=ix4(i)) THEN
163 xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
164 yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
165 zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
166 n1(i)=n1(i)+xn3(i)
167 n2(i)=n2(i)+yn3(i)
168 n3(i)=n3(i)+zn3(i)
169 ELSE
170 xn3(i)=zero
171 yn3(i)=zero
172 zn3(i)=zero
173 ENDIF
174 ENDDO
175C
176 DO i=1,min(mvsiz,nrtm-ideb)
177 xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
178 yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
179 zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
180 n1(i)=n1(i)+xn4(i)
181 n2(i)=n2(i)+yn4(i)
182 n3(i)=n3(i)+zn4(i)
183 ENDDO
184C
185 DO i=1,min(mvsiz,nrtm-ideb)
186 an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
187 n1(i)=n1(i)/an
188 n2(i)=n2(i)/an
189 n3(i)=n3(i)/an
190 ENDDO
191C
192 DO i=1,min(mvsiz,nrtm-ideb)
193 x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
194 z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
195C
196 ! Si element d
197 IF(z0(i)==zero.AND.x0(i)==zero)THEN
198 CALL ancmsg(msgid=558,
199 . msgtype=msgerror,
200 . anmode=aninfo_blind_1,
201 . i1=id,
202 . c1=titr,
203 . i2=itab(ix1(i)),
204 . i3=itab(ix2(i)),
205 . i4=itab(ix3(i)),
206 . i5=itab(ix4(i)))
207 ENDIF
208 ENDDO
209C
210 ideb=ideb+min(mvsiz,nrtm-ideb)
211 ENDDO
212C
213C #######################################################
214
215
216
217
218
219C #######################################################
220C # CHECKING MATERIAL TYPE IN ALE SIDE ##
221C #######################################################
222 imesg = 0
223 DO i=1,nbric
224 ibric = brics(i)
225 mid = ixs(1,ibric)
226 ilaw = nint(pm(19,mid))
227 i22law06 = 0
228 i22law37 = 0
229 i22law51 = 0
230 IF(ilaw == 37) i22law37 = 5 ! UVAR buffer size
231 IF(ilaw == 51) i22law51 = m51_n0phas+4*m51_nvphas ! UVAR buffer size
232
233 IF((ilaw/=0).AND.(ilaw/=11).AND.(ilaw/=51).AND.(ilaw/=6).AND.(ilaw/=37))THEN
234 imesg = 97
235 EXIT
236 END IF
237 END do! next I
238
239 IF(i22law06*i22law37/=0 .OR. i22law06*i22law51/=0 .OR. i22law37*i22law51/=0 )THEN
240 imesg = 91
241 ENDIF
242
243 IF(imesg/=0)THEN
244 CALL ancmsg(msgid = imesg,
245 . msgtype = msgerror,
246 . anmode = aninfo_blind_1,
247 . i1 = id,
248 . c1 = titr)
249 ENDIF
250C #######################################################
251
252
253
254
255 RETURN
256 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:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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:889