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
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "scr03_c.inc"
54#include "vect01_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IXC(NIXC,*)
59 INTEGER , DIMENSION(MVSIZ), INTENT(OUT) :: NGL,
60 . IX1,IX2,IX3,IX4
61 my_real x(3,*),xrefc(4,3,*)
62 my_real , DIMENSION(MVSIZ), INTENT(OUT) ::
63 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I, TEST0, TEST1, TEST2
68 my_real XN14, XN13, XN24, XN23, XN12, X31,
69 . Y31, Z31, X42, Y42, Z42, E3X, E3Y, E3Z, SURF
70C=======================================================================
71C CONNECTIVITES ET SHELL ID
72C----------------------------
73 DO i=lft,llt
74 ix1(i)=ixc(2,i)
75 ix2(i)=ixc(3,i)
76 ix3(i)=ixc(4,i)
77 ix4(i)=ixc(5,i)
78 ngl(i)=ixc(nixc,i)
79 ENDDO
80C----------------------------
81C COORDONNEES
82C----------------------------
83 IF (nxref == 0) THEN
84 DO i=lft,llt
85 x1(i)=x(1,ix1(i))
86 y1(i)=x(2,ix1(i))
87 z1(i)=x(3,ix1(i))
88 x2(i)=x(1,ix2(i))
89 y2(i)=x(2,ix2(i))
90 z2(i)=x(3,ix2(i))
91 x3(i)=x(1,ix3(i))
92 y3(i)=x(2,ix3(i))
93 z3(i)=x(3,ix3(i))
94 x4(i)=x(1,ix4(i))
95 y4(i)=x(2,ix4(i))
96 z4(i)=x(3,ix4(i))
97 ENDDO
98 ELSE
99 DO i=lft,llt
100 x1(i)=xrefc(1,1,i)
101 y1(i)=xrefc(1,2,i)
102 z1(i)=xrefc(1,3,i)
103 x2(i)=xrefc(2,1,i)
104 y2(i)=xrefc(2,2,i)
105 z2(i)=xrefc(2,3,i)
106 x3(i)=xrefc(3,1,i)
107 y3(i)=xrefc(3,2,i)
108 z3(i)=xrefc(3,3,i)
109 x4(i)=xrefc(4,1,i)
110 y4(i)=xrefc(4,2,i)
111 z4(i)=xrefc(4,3,i)
112 ENDDO
113 ENDIF
114c
115 DO i=lft,llt
116 xn14=(x1(i)-x4(i))**2+(y1(i)-y4(i))**2+(z1(i)-z4(i))**2
117 xn13=(x1(i)-x3(i))**2+(y1(i)-y3(i))**2+(z1(i)-z3(i))**2
118 xn24=(x2(i)-x4(i))**2+(y2(i)-y4(i))**2+(z2(i)-z4(i))**2
119 xn23=(x2(i)-x3(i))**2+(y2(i)-y3(i))**2+(z2(i)-z3(i))**2
120 xn12=(x1(i)-x2(i))**2+(y1(i)-y2(i))**2+(z1(i)-z2(i))**2
121 x31=x3(i)-x1(i)
122 y31=y3(i)-y1(i)
123 z31=z3(i)-z1(i)
124 x42=x4(i)-x2(i)
125 y42=y4(i)-y2(i)
126 z42=z4(i)-z2(i)
127 e3x=y31*z42-z31*y42
128 e3y=z31*x42-x31*z42
129 e3z=x31*y42-y31*x42
130 surf=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
131C
132 test0=0
133 test1=0
134 test2=0
135 IF (xn13+xn24+xn12 < em20) THEN
136 CALL ancmsg(msgid=20,anmode=aninfo,msgtype=msgerror,
137 . i1=ixc(nixc,i))
138 test0=1
139 ELSE IF(surf<=em20) THEN
140 CALL ancmsg(msgid=21,anmode=aninfo,msgtype=msgerror,
141 . i1=ixc(nixc,i))
142 test1=1
143 ELSE IF(xn12<=1.e-20.OR.xn23<=1.e-20.OR.xn14<=1.e-20) THEN
144 CALL ancmsg(msgid=22,anmode=aninfo,msgtype=msgerror,
145 . i1=ixc(nixc,i))
146 test2=1
147 ENDIF
148 IF (test0 == 1 .OR. test1 == 1 .OR. test2 == 1) THEN
149 x1(i)=zero
150 y1(i)=zero
151 z1(i)=zero
152 x2(i)=one
153 y2(i)=zero
154 z2(i)=zero
155 x3(i)=one
156 y3(i)=one
157 z3(i)=zero
158 x4(i)=zero
159 y4(i)=one
160 z4(i)=zero
161 ENDIF
162 ENDDO
163C-----------
164 RETURN
165 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
lslocal
subroutine lslocal(elbuf_tab, xfem_tab, iparg, ixc, ixtg, xrefc, xreftg, x, icrk, inod_crk, nxseg, nodls, ratiols, ntag, ielcrkc, ielcrktg, iedgesh4, iedgesh3, nodedge, tagskyc, tagskytg, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom, itab, id, titr)
Definition lslocal.F:50
message_mod
Definition message_mod.F:1249
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
starter
program starter
Definition starter.F:39