OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ccoori.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!|| ccoori ../starter/source/elements/shell/coque/ccoori.F
25!||--- called by ------------------------------------------------------
26!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
27!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
28!|| inirig_mat ../starter/source/elements/initia/inirig_mat.F
29!|| inivoid ../starter/source/elements/initia/inivoid.F
30!|| lslocal ../starter/source/elements/xfem/lslocal.F
31!||--- calls -----------------------------------------------------
32!|| ancmsg ../starter/source/output/message/message.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE ccoori(X,XREFC,IXC,
37 . X1 ,X2 ,X3 ,X4 ,Y1 ,Y2 ,
38 . Y3 ,Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
39 . IX1 ,IX2 ,IX3 ,IX4 ,NGL )
40C-----------------------------------------------
41 USE message_mod
42 use element_mod , only : nixc
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr03_c.inc"
55#include "vect01_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IXC(NIXC,*)
60 INTEGER , DIMENSION(MVSIZ), INTENT(OUT) :: NGL,
61 . IX1,IX2,IX3,IX4
62 my_real x(3,*),xrefc(4,3,*)
63 my_real , DIMENSION(MVSIZ), INTENT(OUT) ::
64 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, TEST0, TEST1, TEST2
69 my_real XN14, XN13, XN24, XN23, XN12, X31,
70 . Y31, Z31, X42, Y42, Z42, E3X, E3Y, E3Z, SURF
71C=======================================================================
72C connectivities and shell id
73C----------------------------
74 DO i=lft,llt
75 ix1(i)=ixc(2,i)
76 ix2(i)=ixc(3,i)
77 ix3(i)=ixc(4,i)
78 ix4(i)=ixc(5,i)
79 ngl(i)=ixc(nixc,i)
80 ENDDO
81C----------------------------
82C COORDONNEES
83C----------------------------
84 IF (nxref == 0) THEN
85 DO i=lft,llt
86 x1(i)=x(1,ix1(i))
87 y1(i)=x(2,ix1(i))
88 z1(i)=x(3,ix1(i))
89 x2(i)=x(1,ix2(i))
90 y2(i)=x(2,ix2(i))
91 z2(i)=x(3,ix2(i))
92 x3(i)=x(1,ix3(i))
93 y3(i)=x(2,ix3(i))
94 z3(i)=x(3,ix3(i))
95 x4(i)=x(1,ix4(i))
96 y4(i)=x(2,ix4(i))
97 z4(i)=x(3,ix4(i))
98 ENDDO
99 ELSE
100 DO i=lft,llt
101 x1(i)=xrefc(1,1,i)
102 y1(i)=xrefc(1,2,i)
103 z1(i)=xrefc(1,3,i)
104 x2(i)=xrefc(2,1,i)
105 y2(i)=xrefc(2,2,i)
106 z2(i)=xrefc(2,3,i)
107 x3(i)=xrefc(3,1,i)
108 y3(i)=xrefc(3,2,i)
109 z3(i)=xrefc(3,3,i)
110 x4(i)=xrefc(4,1,i)
111 y4(i)=xrefc(4,2,i)
112 z4(i)=xrefc(4,3,i)
113 ENDDO
114 ENDIF
115c
116 DO i=lft,llt
117 xn14=(x1(i)-x4(i))**2+(y1(i)-y4(i))**2+(z1(i)-z4(i))**2
118 xn13=(x1(i)-x3(i))**2+(y1(i)-y3(i))**2+(z1(i)-z3(i))**2
119 xn24=(x2(i)-x4(i))**2+(y2(i)-y4(i))**2+(z2(i)-z4(i))**2
120 xn23=(x2(i)-x3(i))**2+(y2(i)-y3(i))**2+(z2(i)-z3(i))**2
121 xn12=(x1(i)-x2(i))**2+(y1(i)-y2(i))**2+(z1(i)-z2(i))**2
122 x31=x3(i)-x1(i)
123 y31=y3(i)-y1(i)
124 z31=z3(i)-z1(i)
125 x42=x4(i)-x2(i)
126 y42=y4(i)-y2(i)
127 z42=z4(i)-z2(i)
128 e3x=y31*z42-z31*y42
129 e3y=z31*x42-x31*z42
130 e3z=x31*y42-y31*x42
131 surf=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
132C
133 test0=0
134 test1=0
135 test2=0
136 IF (xn13+xn24+xn12 < em20) THEN
137 CALL ancmsg(msgid=20,anmode=aninfo,msgtype=msgerror,
138 . i1=ixc(nixc,i))
139 test0=1
140 ELSE IF(surf<=em20) THEN
141 CALL ancmsg(msgid=21,anmode=aninfo,msgtype=msgerror,
142 . i1=ixc(nixc,i))
143 test1=1
144 ELSE IF(xn12<=1.e-20.OR.xn23<=1.e-20.OR.xn14<=1.e-20) THEN
145 CALL ancmsg(msgid=22,anmode=aninfo,msgtype=msgerror,
146 . i1=ixc(nixc,i))
147 test2=1
148 ENDIF
149 IF (test0 == 1 .OR. test1 == 1 .OR. test2 == 1) THEN
150 x1(i)=zero
151 y1(i)=zero
152 z1(i)=zero
153 x2(i)=one
154 y2(i)=zero
155 z2(i)=zero
156 x3(i)=one
157 y3(i)=one
158 z3(i)=zero
159 x4(i)=zero
160 y4(i)=one
161 z4(i)=zero
162 ENDIF
163 ENDDO
164C-----------
165 RETURN
166 END
ccoori
subroutine ccoori(x, xrefc, ixc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, ix1, ix2, ix3, ix4, ngl)
Definition ccoori.F:40
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
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