OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdk6bc3.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!|| cdk6bc3 ../engine/source/elements/sh3n/coquedk6/cdk6bc3.F
25!||--- called by ------------------------------------------------------
26!|| radioss2 ../engine/source/engine/radioss2.F
27!||--- uses -----------------------------------------------------
28!|| element_mod ../common_source/modules/elements/element_mod.F90
29!||====================================================================
30 SUBROUTINE cdk6bc3(ICODR ,ISKEW ,ISKWN ,IXTG ,IXTG1 ,
31 1 NPBY ,X ,SKEW )
32 use element_mod , only : nixtg
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com04_c.inc"
41#include "param_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER ICODR(*),ISKEW(*),ISKWN(LISKN,*),IXTG(NIXTG,*),
46 . ixtg1(4,*),npby(nnpby,*)
47 my_real
48 . x(3,*),skew(lskew,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I,II,IC1,IC2,IC3,N1,N2,N3,J1(3),IS,NELTG3
53 my_real
54 . lx,ly,lz,ll,ll1,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z
55C-----------------------------------------------
56 neltg3 = numeltg-numeltg6
57 DO i=1,numeltg6
58C II=IXTG1(4,I)
59 ii = i + neltg3
60 n1=ixtg(2,ii)
61 n2=ixtg(3,ii)
62 n3=ixtg(4,ii)
63 ic1=icodr(n1)
64 ic2=icodr(n2)
65 ic3=icodr(n3)
66C--------ligne 1--------------
67 IF (ic1>0.AND.ic2>0)THEN
68 lx=x(1,n1)-x(1,n2)
69 ly=x(2,n1)-x(2,n2)
70 lz=x(3,n1)-x(3,n2)
71 ll =sqrt(lx*lx+ly*ly+lz*lz)
72 j1(1)=ic1/4
73 j1(2)=(ic1-4*j1(1))/2
74 j1(3)=(ic1-4*j1(1)-2*j1(2))
75 is=iskew(n1)
76 IF (is==1) THEN
77 e1x=skew(1,is)
78 e1y=skew(2,is)
79 e1z=skew(3,is)
80 e2x=skew(4,is)
81 e2y=skew(5,is)
82 e2z=skew(6,is)
83 e3x=skew(7,is)
84 e3y=skew(8,is)
85 e3z=skew(9,is)
86 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
87 ELSE
88 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
89 ENDIF
90 IF (abs(ll1)/ll>em6) THEN
91 j1(1)=ic2/4
92 j1(2)=(ic2-4*j1(1))/2
93 j1(3)=(ic2-4*j1(1)-2*j1(2))
94 is=iskew(n2)
95 IF (is==1) THEN
96 e1x=skew(1,is)
97 e1y=skew(2,is)
98 e1z=skew(3,is)
99 e2x=skew(4,is)
100 e2y=skew(5,is)
101 e2z=skew(6,is)
102 e3x=skew(7,is)
103 e3y=skew(8,is)
104 e3z=skew(9,is)
105 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
106 ELSE
107 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
108 ENDIF
109 IF (abs(ll1)/ll>em6) ixtg1(1,i)=-1
110 ENDIF
111C--------ligne 2--------------
112 ELSEIF (ic2>0.AND.ic3>0)THEN
113 lx=x(1,n3)-x(1,n2)
114 ly=x(2,n3)-x(2,n2)
115 lz=x(3,n3)-x(3,n2)
116 ll =sqrt(lx*lx+ly*ly+lz*lz)
117 j1(1)=ic3/4
118 j1(2)=(ic3-4*j1(1))/2
119 j1(3)=(ic3-4*j1(1)-2*j1(2))
120 is=iskew(n3)
121 IF (is==1) THEN
122 e1x=skew(1,is)
123 e1y=skew(2,is)
124 e1z=skew(3,is)
125 e2x=skew(4,is)
126 e2y=skew(5,is)
127 e2z=skew(6,is)
128 e3x=skew(7,is)
129 e3y=skew(8,is)
130 e3z=skew(9,is)
131 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
132 ELSE
133 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
134 ENDIF
135 IF (abs(ll1)/ll>em6) THEN
136 j1(1)=ic2/4
137 j1(2)=(ic2-4*j1(1))/2
138 j1(3)=(ic2-4*j1(1)-2*j1(2))
139 is=iskew(n2)
140 IF (is==1) THEN
141 e1x=skew(1,is)
142 e1y=skew(2,is)
143 e1z=skew(3,is)
144 e2x=skew(4,is)
145 e2y=skew(5,is)
146 e2z=skew(6,is)
147 e3x=skew(7,is)
148 e3y=skew(8,is)
149 e3z=skew(9,is)
150 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
151 ELSE
152 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
153 ENDIF
154 IF (abs(ll1)/ll>em6) ixtg1(2,i)=-1
155 ENDIF
156C--------ligne 3--------------
157 ELSEIF (ic1>0.AND.ic3>0)THEN
158 lx=x(1,n3)-x(1,n1)
159 ly=x(2,n3)-x(2,n1)
160 lz=x(3,n3)-x(3,n1)
161 ll =sqrt(lx*lx+ly*ly+lz*lz)
162 j1(1)=ic3/4
163 j1(2)=(ic3-4*j1(1))/2
164 j1(3)=(ic3-4*j1(1)-2*j1(2))
165 is=iskew(n3)
166 IF (is==1) THEN
167 e1x=skew(1,is)
168 e1y=skew(2,is)
169 e1z=skew(3,is)
170 e2x=skew(4,is)
171 e2y=skew(5,is)
172 e2z=skew(6,is)
173 e3x=skew(7,is)
174 e3y=skew(8,is)
175 e3z=skew(9,is)
176 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
177 ELSE
178 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
179 ENDIF
180 IF (abs(ll1)/ll>em6) THEN
181 j1(1)=ic1/4
182 j1(2)=(ic1-4*j1(1))/2
183 j1(3)=(ic1-4*j1(1)-2*j1(2))
184 is=iskew(n1)
185 IF (is==1) THEN
186 e1x=skew(1,is)
187 e1y=skew(2,is)
188 e1z=skew(3,is)
189 e2x=skew(4,is)
190 e2y=skew(5,is)
191 e2z=skew(6,is)
192 e3x=skew(7,is)
193 e3y=skew(8,is)
194 e3z=skew(9,is)
195 ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
196 ELSE
197 ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
198 ENDIF
199 IF (abs(ll1)/ll>em6) ixtg1(3,i)=-1
200 ENDIF
201 ENDIF
202 ENDDO
203C-----------------------------------------------
204 RETURN
205 END
cdk6bc3
subroutine cdk6bc3(icodr, iskew, iskwn, ixtg, ixtg1, npby, x, skew)
Definition cdk6bc3.F:32
my_real
#define my_real
Definition cppsort.cpp:32