OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
czcorp5.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!|| czcorp5 ../engine/source/elements/shell/coquez/czcorp5.F
25!||--- called by ------------------------------------------------------
26!|| czcorc1 ../engine/source/elements/shell/coquez/czcorc.F
27!||--- calls -----------------------------------------------------
28!|| a3invdp_v ../engine/source/elements/shell/coquez/a3invdp_v.F
29!||====================================================================
30 SUBROUTINE czcorp5( NUMNOD ,NEL ,NUMELC ,VR ,NPT ,TOL ,
31 2 IXC ,PLAT ,AREA ,AREA_I ,V13 ,
32 3 V24 ,VHI ,RLXYZ ,VQN ,VQ ,
33 4 X13 ,X24 ,Y13 ,Y24 ,MX13 ,
34 6 MY13 ,
35 7 Z1 ,DI ,DB ,COREL ,RLZ ,
36 8 LL ,
37 9 L13 ,L24 ,IDRIL ,DIZ )
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46#include "impl1_c.inc"
47#include "scr05_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NUMNOD,NEL,NUMELC,IDRIL,NPT
52 LOGICAL, DIMENSION(NEL), INTENT(INOUT) :: PLAT
53 INTEGER, DIMENSION(NIXC,NUMELC), INTENT(IN) :: IXC
54 my_real, DIMENSION(3,NUMNOD), INTENT(IN) :: VR
55 my_real, DIMENSION(MVSIZ,3), INTENT(INOUT) :: V13,V24,VHI,DIZ
56 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: DI
57 my_real, DIMENSION(MVSIZ,3,3), INTENT(INOUT) :: VQ
58 my_real, DIMENSION(MVSIZ,3,4), INTENT(INOUT) :: vqn,db
59 my_real, DIMENSION(MVSIZ,2,4), INTENT(INOUT) :: rlxyz,corel
60 my_real, DIMENSION(MVSIZ,4), INTENT(INOUT) :: rlz
61 my_real, DIMENSION(NEL), INTENT(INOUT) :: mx13,my13
62 my_real, DIMENSION(NEL), INTENT(INOUT) :: x13,x24,y13,y24
63 my_real, DIMENSION(NEL), INTENT(INOUT) :: area,z1,area_i
64 my_real, DIMENSION(NEL), INTENT(INOUT) :: ll,l13,l24
65 my_real, INTENT(INOUT) :: tol
66C-----------------------------------------------
67C L O C A L V A R I A B L E S
68C-----------------------------------------------
69 INTEGER NNOD,I,J,K,L
70 parameter(nnod = 4)
71 my_real :: deta,
72 . rrxyz(mvsiz,3,nnod),
73 . z2(mvsiz),a_4,sz,sz1,sz2,sl,c1,c2,
74 . ar(mvsiz,3),btb(6),xx(mvsiz),yy(mvsiz),zz(mvsiz),xy(mvsiz),xz(mvsiz),yz(mvsiz),
75 . abc,xxyz2,yyxz2,zzxy2,d(mvsiz,6),diz1(mvsiz,6),diz2(mvsiz,6),
76 . alr(3),ald(nnod),dbad(3),btb_c,alrz
77 my_real, DIMENSION(MVSIZ,NNOD) :: ad
78C----------------------------------
79 DO i=1,nel
80 z2(i)=z1(i)*z1(i)
81 IF (z2(i)<ll(i)*tol.OR.npt == 1) THEN
82 z1(i)=zero
83 plat(i)=.true.
84 ELSE
85 plat(i)=.false.
86C--------------------------------------------------
87C WARPING SPECIAL TREATMENT
88C full projection eliminer drilling rotations and rigid rotations
89C--------------------------------------------------------------------------
90 a_4=area(i)*fourth
91C
92C---------- node N ----------
93 sz1=mx13(i)*y24(i)-my13(i)*x24(i)
94 sz2=a_4+sz1
95 sz=z2(i)*l24(i)
96 sl=one/sqrt(sz+sz2*sz2)
97 vqn(i,1,1)=-z1(i)*y24(i)
98 vqn(i,2,1)= z1(i)*x24(i)
99 vqn(i,3,1)= sz2*sl
100 vqn(i,1,3)=-vqn(i,1,1)
101 vqn(i,2,3)=-vqn(i,2,1)
102 vqn(i,1,1)= vqn(i,1,1)*sl
103 vqn(i,2,1)= vqn(i,2,1)*sl
104C
105 sz2=a_4-sz1
106 sl=one/sqrt(sz+sz2*sz2)
107 vqn(i,1,3)= vqn(i,1,3)*sl
108 vqn(i,2,3)= vqn(i,2,3)*sl
109 vqn(i,3,3)= sz2*sl
110C
111 sz1=mx13(i)*y13(i)-my13(i)*x13(i)
112 sz2=a_4+sz1
113 sz=z2(i)*l13(i)
114 sl=one/sqrt(sz+sz2*sz2)
115 vqn(i,1,2)=-z1(i)*y13(i)
116 vqn(i,2,2)= z1(i)*x13(i)
117 vqn(i,3,2)= sz2*sl
118 vqn(i,1,4)=-vqn(i,1,2)
119 vqn(i,2,4)=-vqn(i,2,2)
120 vqn(i,1,2)= vqn(i,1,2)*sl
121 vqn(i,2,2)= vqn(i,2,2)*sl
122C
123 sz2=a_4-sz1
124 sl=one/sqrt(sz+sz2*sz2)
125 vqn(i,1,4)= vqn(i,1,4)*sl
126 vqn(i,2,4)= vqn(i,2,4)*sl
127 vqn(i,3,4)= sz2*sl
128C
129 k=ixc(2,i)
130 rrxyz(i,1,1) =rlxyz(i,1,1)
131 rrxyz(i,2,1) =rlxyz(i,2,1)
132 rrxyz(i,3,1) =vq(i,1,3)*vr(1,k)+vq(i,2,3)*vr(2,k)
133 1 +vq(i,3,3)*vr(3,k)
134 k=ixc(3,i)
135 rrxyz(i,1,2) =rlxyz(i,1,2)
136 rrxyz(i,2,2) =rlxyz(i,2,2)
137 rrxyz(i,3,2) =vq(i,1,3)*vr(1,k)+vq(i,2,3)*vr(2,k)
138 1 +vq(i,3,3)*vr(3,k)
139 k=ixc(4,i)
140 rrxyz(i,1,3) =rlxyz(i,1,3)
141 rrxyz(i,2,3) =rlxyz(i,2,3)
142 rrxyz(i,3,3) =vq(i,1,3)*vr(1,k)+vq(i,2,3)*vr(2,k)
143 1 +vq(i,3,3)*vr(3,k)
144 k=ixc(5,i)
145 rrxyz(i,1,4) =rlxyz(i,1,4)
146 rrxyz(i,2,4) =rlxyz(i,2,4)
147 rrxyz(i,3,4) =vq(i,1,3)*vr(1,k)+vq(i,2,3)*vr(2,k)
148 1 +vq(i,3,3)*vr(3,k)
149 ENDIF
150 ENDDO
151
152 IF (impl_s>0.AND.ikproj<=0) THEN
153C-------------------------------------
154C DRILLING PROJECTION ONLY
155C-------------------------------------
156 DO i=1,nel
157 IF(.NOT.plat(i)) THEN
158 IF (idril>0.0 ) THEN
159 rlz(i,1)=area_i(i)*(vqn(i,1,1)*rrxyz(i,1,1)+
160 1 vqn(i,2,1)*rrxyz(i,2,1)+vqn(i,3,1)*rrxyz(i,3,1))
161 rlz(i,2)=area_i(i)*(vqn(i,1,2)*rrxyz(i,1,2)+
162 1 vqn(i,2,2)*rrxyz(i,2,2)+vqn(i,3,2)*rrxyz(i,3,2))
163 rlz(i,3)=area_i(i)*(vqn(i,1,3)*rrxyz(i,1,3)+
164 1 vqn(i,2,3)*rrxyz(i,2,3)+vqn(i,3,3)*rrxyz(i,3,3))
165 rlz(i,4)=area_i(i)*(vqn(i,1,4)*rrxyz(i,1,4)+
166 1 vqn(i,2,4)*rrxyz(i,2,4)+vqn(i,3,4)*rrxyz(i,3,4))
167 END IF
168 rlxyz(i,1,1)=(1.-vqn(i,1,1)*vqn(i,1,1))*rrxyz(i,1,1)
169 1 -vqn(i,1,1)*vqn(i,2,1) *rrxyz(i,2,1)
170 2 -vqn(i,1,1)*vqn(i,3,1) *rrxyz(i,3,1)
171 rlxyz(i,2,1)=(1.-vqn(i,2,1)*vqn(i,2,1))*rrxyz(i,2,1)
172 1 -vqn(i,1,1)*vqn(i,2,1) *rrxyz(i,1,1)
173 2 -vqn(i,2,1)*vqn(i,3,1) *rrxyz(i,3,1)
174C
175 rlxyz(i,1,2)=(1.-vqn(i,1,2)*vqn(i,1,2))*rrxyz(i,1,2)
176 1 -vqn(i,1,2)*vqn(i,2,2) *rrxyz(i,2,2)
177 2 -vqn(i,1,2)*vqn(i,3,2) *rrxyz(i,3,2)
178 rlxyz(i,2,2)=(1.-vqn(i,2,2)*vqn(i,2,2))*rrxyz(i,2,2)
179 1 -vqn(i,1,2)*vqn(i,2,2) *rrxyz(i,1,2)
180 2 -vqn(i,2,2)*vqn(i,3,2) *rrxyz(i,3,2)
181C
182 rlxyz(i,1,3)=(1.-vqn(i,1,3)*vqn(i,1,3))*rrxyz(i,1,3)
183 1 -vqn(i,1,3)*vqn(i,2,3) *rrxyz(i,2,3)
184 2 -vqn(i,1,3)*vqn(i,3,3) *rrxyz(i,3,3)
185 rlxyz(i,2,3)=(1.-vqn(i,2,3)*vqn(i,2,3))*rrxyz(i,2,3)
186 1 -vqn(i,1,3)*vqn(i,2,3) *rrxyz(i,1,3)
187 2 -vqn(i,2,3)*vqn(i,3,3) *rrxyz(i,3,3)
188C
189 rlxyz(i,1,4)=(1.-vqn(i,1,4)*vqn(i,1,4))*rrxyz(i,1,4)
190 1 -vqn(i,1,4)*vqn(i,2,4) *rrxyz(i,2,4)
191 2 -vqn(i,1,4)*vqn(i,3,4) *rrxyz(i,3,4)
192 rlxyz(i,2,4)=(1.-vqn(i,2,4)*vqn(i,2,4))*rrxyz(i,2,4)
193 1 -vqn(i,1,4)*vqn(i,2,4) *rrxyz(i,1,4)
194 2 -vqn(i,2,4)*vqn(i,3,4) *rrxyz(i,3,4)
195 ENDIF ! plat
196 ENDDO
197 ELSE
198C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
199C-----------------------full projection------------------
200 DO i=1,nel
201 IF(.NOT.plat(i)) THEN
202 ar(i,1)=-z1(i)*vhi(i,2)+y13(i)*v13(i,3)+y24(i)*v24(i,3)
203 1 +my13(i)*vhi(i,3)
204 2 +rrxyz(i,1,1)+rrxyz(i,1,2)+rrxyz(i,1,3)+rrxyz(i,1,4)
205 ar(i,2)= z1(i)*vhi(i,1)-x13(i)*v13(i,3)-x24(i)*v24(i,3)
206 1 -mx13(i)*vhi(i,3)
207 2 +rrxyz(i,2,1)+rrxyz(i,2,2)+rrxyz(i,2,3)+rrxyz(i,2,4)
208 ar(i,3)= x13(i)*v13(i,2)+x24(i)*v24(i,2)+mx13(i)*vhi(i,2)
209 1 -y13(i)*v13(i,1)-y24(i)*v24(i,1)-my13(i)*vhi(i,1)
210 2 +rrxyz(i,3,1)+rrxyz(i,3,2)+rrxyz(i,3,3)+rrxyz(i,3,4)
211 ad(i,1)= vqn(i,1,1)*rrxyz(i,1,1)+vqn(i,2,1)*rrxyz(i,2,1)+
212 1 vqn(i,3,1)*rrxyz(i,3,1)
213 ad(i,2)= vqn(i,1,2)*rrxyz(i,1,2)+vqn(i,2,2)*rrxyz(i,2,2)+
214 1 vqn(i,3,2)*rrxyz(i,3,2)
215 ad(i,3)= vqn(i,1,3)*rrxyz(i,1,3)+vqn(i,2,3)*rrxyz(i,2,3)+
216 1 vqn(i,3,3)*rrxyz(i,3,3)
217 ad(i,4)= vqn(i,1,4)*rrxyz(i,1,4)+vqn(i,2,4)*rrxyz(i,2,4)+
218 1 vqn(i,3,4)*rrxyz(i,3,4)
219C
220C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
221 xx(i) = corel(i,1,1)*corel(i,1,1)+corel(i,1,2)*corel(i,1,2)
222 1 +corel(i,1,3)*corel(i,1,3)+corel(i,1,4)*corel(i,1,4)
223 yy(i) = corel(i,2,1)*corel(i,2,1)+corel(i,2,2)*corel(i,2,2)
224 1 +corel(i,2,3)*corel(i,2,3)+corel(i,2,4)*corel(i,2,4)
225 xy(i) = corel(i,1,1)*corel(i,2,1)+corel(i,1,2)*corel(i,2,2)
226 1 +corel(i,1,3)*corel(i,2,3)+corel(i,1,4)*corel(i,2,4)
227 xz(i) =(corel(i,1,1)-corel(i,1,2)+corel(i,1,3)-corel(i,1,4))
228 . *z1(i)
229 yz(i) =(corel(i,2,1)-corel(i,2,2)+corel(i,2,3)-corel(i,2,4))
230 . *z1(i)
231 zz(i) = four*z2(i)
232C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
233 btb(1)= vqn(i,1,1)*vqn(i,1,1)+vqn(i,1,2)*vqn(i,1,2)
234 1 +vqn(i,1,3)*vqn(i,1,3)+vqn(i,1,4)*vqn(i,1,4)
235 btb(2)= vqn(i,2,1)*vqn(i,2,1)+vqn(i,2,2)*vqn(i,2,2)
236 1 +vqn(i,2,3)*vqn(i,2,3)+vqn(i,2,4)*vqn(i,2,4)
237 btb(3)= vqn(i,3,1)*vqn(i,3,1)+vqn(i,3,2)*vqn(i,3,2)
238 1 +vqn(i,3,3)*vqn(i,3,3)+vqn(i,3,4)*vqn(i,3,4)
239 btb(4)= vqn(i,1,1)*vqn(i,2,1)+vqn(i,1,2)*vqn(i,2,2)
240 1 +vqn(i,1,3)*vqn(i,2,3)+vqn(i,1,4)*vqn(i,2,4)
241 btb(5)= vqn(i,1,1)*vqn(i,3,1)+vqn(i,1,2)*vqn(i,3,2)
242 1 +vqn(i,1,3)*vqn(i,3,3)+vqn(i,1,4)*vqn(i,3,4)
243 btb(6)= vqn(i,2,1)*vqn(i,3,1)+vqn(i,2,2)*vqn(i,3,2)
244 1 +vqn(i,2,3)*vqn(i,3,3)+vqn(i,2,4)*vqn(i,3,4)
245 d(i,1)= yy(i)+zz(i)+four-btb(1)
246 d(i,2)= xx(i)+zz(i)+four-btb(2)
247 d(i,3)= xx(i)+yy(i)+four-btb(3)
248 d(i,4)= -xy(i)-btb(4)
249 d(i,5)= -xz(i)-btb(5)
250 d(i,6)= -yz(i)-btb(6)
251 ENDIF
252 ENDDO
253 IF(iresp == 1)THEN
254 CALL a3invdp_v(d,diz2,nel,plat)
255 DO i=1,nel
256 IF(.NOT.plat(i)) THEN
257 di(i,1) = diz2(i,1)
258 di(i,2) = diz2(i,2)
259 di(i,3) = diz2(i,3)
260 di(i,4) = diz2(i,4)
261 di(i,5) = diz2(i,5)
262 di(i,6) = diz2(i,6)
263 ENDIF
264 ENDDO
265 ELSE
266 DO i=1,nel
267 IF(.NOT.plat(i)) THEN
268 abc = d(i,1)*d(i,2)*d(i,3)
269 xxyz2 = d(i,1)*d(i,6)*d(i,6)
270 yyxz2 = d(i,2)*d(i,5)*d(i,5)
271 zzxy2 = d(i,3)*d(i,4)*d(i,4)
272 deta = abs(abc+two*d(i,4)*d(i,5)*d(i,6)-xxyz2-yyxz2-zzxy2)
273 deta = one/max(deta,em20)
274 di(i,1) = (abc-xxyz2)*deta/max(d(i,1),em20)
275 di(i,2) = (abc-yyxz2)*deta/max(d(i,2),em20)
276 di(i,3) = (abc-zzxy2)*deta/max(d(i,3),em20)
277 di(i,4) = (d(i,5)*d(i,6)-d(i,4)*d(i,3))*deta
278 di(i,5) = (d(i,6)*d(i,4)-d(i,5)*d(i,2))*deta
279 di(i,6) = (d(i,4)*d(i,5)-d(i,6)*d(i,1))*deta
280 ENDIF
281 ENDDO
282 END IF !(IRESP == 1)THEN
283 DO j=1,nnod
284 DO i=1,nel
285 IF(.NOT.plat(i)) THEN
286 db(i,1,j)= di(i,1)*vqn(i,1,j)+di(i,4)*vqn(i,2,j)
287 1 +di(i,5)*vqn(i,3,j)
288 db(i,2,j)= di(i,4)*vqn(i,1,j)+di(i,2)*vqn(i,2,j)
289 1 +di(i,6)*vqn(i,3,j)
290 db(i,3,j)= di(i,5)*vqn(i,1,j)+di(i,6)*vqn(i,2,j)
291 1 +di(i,3)*vqn(i,3,j)
292 ENDIF
293 ENDDO
294 ENDDO
295C
296 DO i=1,nel
297 IF(.NOT.plat(i)) THEN
298 dbad(1)= db(i,1,1)*ad(i,1)+db(i,1,2)*ad(i,2)
299 1 +db(i,1,3)*ad(i,3)+db(i,1,4)*ad(i,4)
300 dbad(2)= db(i,2,1)*ad(i,1)+db(i,2,2)*ad(i,2)
301 1 +db(i,2,3)*ad(i,3)+db(i,2,4)*ad(i,4)
302 dbad(3)= db(i,3,1)*ad(i,1)+db(i,3,2)*ad(i,2)
303 1 +db(i,3,3)*ad(i,3)+db(i,3,4)*ad(i,4)
304C
305 alr(1) =di(i,1)*ar(i,1)+di(i,4)*ar(i,2)+di(i,5)*ar(i,3)-dbad(1)
306 alr(2) =di(i,4)*ar(i,1)+di(i,2)*ar(i,2)+di(i,6)*ar(i,3)-dbad(2)
307 alr(3) =di(i,5)*ar(i,1)+di(i,6)*ar(i,2)+di(i,3)*ar(i,3)-dbad(3)
308C
309 ald(1) = ad(i,1)+vqn(i,1,1)*dbad(1)+vqn(i,2,1)*dbad(2)
310 1 +vqn(i,3,1)*dbad(3)
311 2 -db(i,1,1)*ar(i,1)-db(i,2,1)*ar(i,2)-db(i,3,1)*ar(i,3)
312 ald(2) = ad(i,2)+vqn(i,1,2)*dbad(1)+vqn(i,2,2)*dbad(2)
313 1 +vqn(i,3,2)*dbad(3)
314 2 -db(i,1,2)*ar(i,1)-db(i,2,2)*ar(i,2)-db(i,3,2)*ar(i,3)
315 ald(3) = ad(i,3)+vqn(i,1,3)*dbad(1)+vqn(i,2,3)*dbad(2)
316 1 +vqn(i,3,3)*dbad(3)
317 2 -db(i,1,3)*ar(i,1)-db(i,2,3)*ar(i,2)-db(i,3,3)*ar(i,3)
318 ald(4) = ad(i,4)+vqn(i,1,4)*dbad(1)+vqn(i,2,4)*dbad(2)
319 1 +vqn(i,3,4)*dbad(3)
320 2 -db(i,1,4)*ar(i,1)-db(i,2,4)*ar(i,2)-db(i,3,4)*ar(i,3)
321C
322 c1 = two*alr(3)
323 v13(i,1)= v13(i,1)+c1*y13(i)
324 v24(i,1)= v24(i,1)+c1*y24(i)
325 vhi(i,1)= vhi(i,1)+four*(alr(3)*my13(i)-z1(i)*alr(2))
326 v13(i,2)= v13(i,2)-c1*x13(i)
327 v24(i,2)= v24(i,2)-c1*x24(i)
328 vhi(i,2)= vhi(i,2)-four*(alr(3)*mx13(i)-z1(i)*alr(1))
329 v13(i,3)= v13(i,3)-two*(y13(i)*alr(1)-x13(i)*alr(2))
330 v24(i,3)= v24(i,3)-two*(y24(i)*alr(1)-x24(i)*alr(2))
331 vhi(i,3)= vhi(i,3)+four*(mx13(i)*alr(2)-my13(i)*alr(1))
332 rlxyz(i,1,1)= rrxyz(i,1,1)-alr(1)-vqn(i,1,1)*ald(1)
333 rlxyz(i,1,2)= rrxyz(i,1,2)-alr(1)-vqn(i,1,2)*ald(2)
334 rlxyz(i,1,3)= rrxyz(i,1,3)-alr(1)-vqn(i,1,3)*ald(3)
335 rlxyz(i,1,4)= rrxyz(i,1,4)-alr(1)-vqn(i,1,4)*ald(4)
336C
337 rlxyz(i,2,1)= rrxyz(i,2,1)-alr(2)-vqn(i,2,1)*ald(1)
338 rlxyz(i,2,2)= rrxyz(i,2,2)-alr(2)-vqn(i,2,2)*ald(2)
339 rlxyz(i,2,3)= rrxyz(i,2,3)-alr(2)-vqn(i,2,3)*ald(3)
340 rlxyz(i,2,4)= rrxyz(i,2,4)-alr(2)-vqn(i,2,4)*ald(4)
341 ENDIF
342 ENDDO
343 IF (idril>0) THEN
344 DO i=1,nel
345 IF(.NOT.plat(i)) THEN
346 d(i,1)= yy(i)+zz(i)+four
347 d(i,2)= xx(i)+zz(i)+four
348 d(i,3)= xx(i)+yy(i)+four
349 d(i,4)= -xy(i)
350 d(i,5)= -xz(i)
351 d(i,6)= -yz(i)
352 ENDIF
353 ENDDO
354 IF(iresp == 1)THEN
355 CALL a3invdp_v(d,diz1,nel,plat)
356 DO i=1,nel
357 IF(.NOT.plat(i)) THEN
358 diz(i,3) = diz1(i,3)
359 diz(i,1) = diz1(i,5)
360 diz(i,2) = diz1(i,6)
361 ENDIF
362 ENDDO
363 ELSE
364 DO i=1,nel
365 IF(.NOT.plat(i)) THEN
366 abc = d(i,1)*d(i,2)*d(i,3)
367 xxyz2 = d(i,1)*d(i,6)*d(i,6)
368 yyxz2 = d(i,2)*d(i,5)*d(i,5)
369 zzxy2 = d(i,3)*d(i,4)*d(i,4)
370 deta = abs(abc+two*d(i,4)*d(i,5)*d(i,6)-xxyz2-yyxz2-zzxy2)
371 deta = one/max(deta,em20)
372 diz(i,3) = (abc-zzxy2)*deta/max(d(i,3),em20)
373 diz(i,1) = (d(i,6)*d(i,4)-d(i,5)*d(i,2))*deta
374 diz(i,2) = (d(i,4)*d(i,5)-d(i,6)*d(i,1))*deta
375 ENDIF
376 ENDDO
377 END IF !(IRESP == 1)THEN
378C
379 DO i=1,nel
380 IF(.NOT.plat(i)) THEN
381 alrz=area_i(i)*(diz(i,1)*ar(i,1)+diz(i,2)*ar(i,2)+diz(i,3)*ar(i,3))
382 rlz(i,1)=rlz(i,1)-alrz
383 rlz(i,2)=rlz(i,2)-alrz
384 rlz(i,3)=rlz(i,3)-alrz
385 rlz(i,4)=rlz(i,4)-alrz
386 ENDIF
387 ENDDO
388 END IF !IF (IDRIL>0) THEN
389C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
390 END IF !((IMPL_S>0.AND.IKPROJ<0).OR.IDRIL>0) THEN
391
392 RETURN
393 END SUBROUTINE czcorp5
subroutine a3invdp_v(d, di, nel, plat)
Definition a3invdp_v.F:29
subroutine czcorp5(numnod, nel, numelc, vr, npt, tol, ixc, plat, area, area_i, v13, v24, vhi, rlxyz, vqn, vq, x13, x24, y13, y24, mx13, my13, z1, di, db, corel, rlz, ll, l13, l24, idril, diz)
Definition czcorp5.F:38
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21