OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
czcoork3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine czcoork3 (jft, jlt, x, ixc, pm, offg, area, area_i, vqn, vq, x13, x24, y13, y24, mx13, mx23, mx34, my13, my23, my34, z1, geo, elbuf_str, smstr, nlay, irep, npt, ismstr, dir_a, dir_b, pid, mat, ngl, nplat, iplat, corelv, off, thk, nel)

Function/Subroutine Documentation

◆ czcoork3()

subroutine czcoork3 ( integer jft,
integer jlt,
x,
integer, dimension(nixc,*) ixc,
pm,
offg,
area,
area_i,
vqn,
vq,
x13,
x24,
y13,
y24,
mx13,
mx23,
mx34,
my13,
my23,
my34,
z1,
geo,
type(elbuf_struct_) elbuf_str,
double precision, dimension(*) smstr,
integer nlay,
integer irep,
integer npt,
integer ismstr,
dir_a,
dir_b,
integer, dimension(*) pid,
integer, dimension(*) mat,
integer, dimension(*) ngl,
integer nplat,
integer, dimension(*) iplat,
corelv,
off,
thk,
integer nel )

Definition at line 33 of file czcoork3.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
47#include "implicit_f.inc"
48c-----------------------------------------------
49c g l o b a l p a r a m e t e r s
50c-----------------------------------------------
51#include "mvsiz_p.inc"
52#include "param_c.inc"
53#include "impl1_c.inc"
54#include "comlock.inc"
55#include "units_c.inc"
56#include "scr17_c.inc"
57C-----------------------------------------------
58C D U M M Y A R G U M E N T S
59C-----------------------------------------------
60 INTEGER IXC(NIXC,*),JFT,JLT,IREP,NPT,ISMSTR,PID(*),MAT(*),NGL(*),NEL
61 INTEGER NPLAT,NLAY,IPLAT(*)
62 my_real
63 . pm(npropm,*),geo(npropg,*), x(3,*),
64 . mx23(*),my13(*),my23(*),my34(*),
65 . x13(*),x24(*),y13(*),y24(*),mx13(*),
66 . vq(mvsiz,3,3),area(*),z1(*),mx34(*),vqn(mvsiz,3,4),area_i(*)
67C . DI(6,*),DB(3,4,*)
68 my_real
69 . dir_a(nel,*),dir_b(nel,*),offg(*),off(*),
70 . corelv(mvsiz,2,4),thk(*)
71 double precision
72 . smstr(*)
73 TYPE(ELBUF_STRUCT_) :: ELBUF_STR
74C-----------------------------------------------
75C L O C A L V A R I A B L E S
76C-----------------------------------------------
77 INTEGER NNOD,I,J,K,L,M,II(6),SPLAT,JPLAT(MVSIZ),MAT_1
78 parameter(nnod = 4)
79 my_real
80 . lxyz0(3),deta,deta1(mvsiz),rx(mvsiz), ry(mvsiz), rz(mvsiz),
81 . sx(mvsiz),sy(mvsiz),r11(mvsiz),r12(mvsiz),r13(mvsiz),
82 . r21(mvsiz),r22(mvsiz),r23(mvsiz),r31(mvsiz),r32(mvsiz),
83 . r33(mvsiz),xl2(mvsiz),xl3(mvsiz),xl4(mvsiz),yl2(mvsiz),
84 . yl3(mvsiz),yl4(mvsiz),ssz(mvsiz),
85 . vcore(3,nnod),l13(mvsiz),l24(mvsiz),ll(mvsiz),
86 . tol,x13_2(mvsiz),y13_2(mvsiz),x24_2(mvsiz),y24_2(mvsiz),
87 . z2(mvsiz),a_4,sz,sz1,sz2,sl,c1,c2,s1,
88 . ar(3),ad(nnod),btb(3),xx,yy,zz,xy,d(6),
89 . alr(3),ald(nnod),dbad(3),btb_c,j0,j1,j2
90 my_real
91 . xx1,xx2,xx3,xx4,yy1,yy2,yy3,yy4,zz1,zz2,zz3,zz4
92C-----------------------------------------------
93 DO i=1,6
94 ii(i) = nel*(i-1)
95 ENDDO
96C
97 tol=em8
98 mat_1 = ixc(1,jft)
99 DO i=jft,jlt
100 mat(i) = mat_1
101 pid(i) = ixc(6,i)
102 ngl(i) = ixc(7,i)
103 ENDDO
104C----------------------------
105C LOCAL SYSTEM
106C----------------------------
107 DO i=jft,jlt
108 rx(i)=x(1,ixc(3,i))+x(1,ixc(4,i))-x(1,ixc(2,i))-x(1,ixc(5,i))
109 sx(i)=x(1,ixc(4,i))+x(1,ixc(5,i))-x(1,ixc(2,i))-x(1,ixc(3,i))
110 ry(i)=x(2,ixc(3,i))+x(2,ixc(4,i))-x(2,ixc(2,i))-x(2,ixc(5,i))
111 sy(i)=x(2,ixc(4,i))+x(2,ixc(5,i))-x(2,ixc(2,i))-x(2,ixc(3,i))
112 rz(i)=x(3,ixc(3,i))+x(3,ixc(4,i))-x(3,ixc(2,i))-x(3,ixc(5,i))
113 ssz(i)=x(3,ixc(4,i))+x(3,ixc(5,i))-x(3,ixc(2,i))-x(3,ixc(3,i))
114 ENDDO
115 k = 0
116 CALL clskew3(jft,jlt,k,
117 . rx, ry, rz,
118 . sx, sy, ssz,
119 . r11,r12,r13,r21,r22,r23,r31,r32,r33,deta1,offg )
120 DO i=jft,jlt
121 area(i)=fourth*deta1(i)
122 area_i(i)=one/area(i)
123 vq(i,1,1)=r11(i)
124 vq(i,2,1)=r21(i)
125 vq(i,3,1)=r31(i)
126 vq(i,1,2)=r12(i)
127 vq(i,2,2)=r22(i)
128 vq(i,3,2)=r32(i)
129 vq(i,1,3)=r13(i)
130 vq(i,2,3)=r23(i)
131 vq(i,3,3)=r33(i)
132 ENDDO
133C--------------------------
134C TRANSMET GLOBAL-->LOCAL
135C--------------------------
136 DO i=jft,jlt
137 j=ixc(2,i)
138 k=ixc(3,i)
139 l=ixc(4,i)
140 m=ixc(5,i)
141 lxyz0(1)=fourth*(x(1,l)+x(1,m)+x(1,j)+x(1,k))
142 lxyz0(2)=fourth*(x(2,l)+x(2,m)+x(2,j)+x(2,k))
143 lxyz0(3)=fourth*(x(3,l)+x(3,m)+x(3,j)+x(3,k))
144C
145 xx1=x(1,k)-x(1,j)
146 yy1=x(2,k)-x(2,j)
147 zz1=x(3,k)-x(3,j)
148C
149 xl2(i)=r11(i)*xx1+r21(i)*yy1+r31(i)*zz1
150 yl2(i)=r12(i)*xx1+r22(i)*yy1+r32(i)*zz1
151C
152 xx2=x(1,j)-lxyz0(1)
153 yy2=x(2,j)-lxyz0(2)
154 zz2=x(3,j)-lxyz0(3)
155 z1(i)=r13(i)*xx2+r23(i)*yy2+r33(i)*zz2
156C
157 xx3=x(1,l)-x(1,j)
158 yy3=x(2,l)-x(2,j)
159 zz3=x(3,l)-x(3,j)
160 xl3(i)=r11(i)*xx3+r21(i)*yy3+r31(i)*zz3
161 yl3(i)=r12(i)*xx3+r22(i)*yy3+r32(i)*zz3
162C
163 xx4=x(1,m)-x(1,j)
164 yy4=x(2,m)-x(2,j)
165 zz4=x(3,m)-x(3,j)
166 xl4(i)=r11(i)*xx4+r21(i)*yy4+r31(i)*zz4
167 yl4(i)=r12(i)*xx4+r22(i)*yy4+r32(i)*zz4
168 ENDDO
169C----------------------------
170C SMALL STRAIN
171C----------------------------
172 IF(ismstr==1.OR.ismstr==2)THEN
173 DO i=jft,jlt
174 IF(abs(offg(i))==two)THEN
175 xl2(i)=smstr(ii(1)+i)
176 yl2(i)=smstr(ii(2)+i)
177 xl3(i)=smstr(ii(3)+i)
178 yl3(i)=smstr(ii(4)+i)
179 xl4(i)=smstr(ii(5)+i)
180 yl4(i)=smstr(ii(6)+i)
181 z1(i)=zero
182 area(i)=half*
183 . ((xl2(i)-xl4(i))*yl3(i)-xl3(i)*(yl2(i)-yl4(i)))
184 area_i(i)=one/max(em20,area(i))
185 ELSE
186 smstr(ii(1)+i)=xl2(i)
187 smstr(ii(2)+i)=yl2(i)
188 smstr(ii(3)+i)=xl3(i)
189 smstr(ii(4)+i)=yl3(i)
190 smstr(ii(5)+i)=xl4(i)
191 smstr(ii(6)+i)=yl4(i)
192 ENDIF
193 ENDDO
194 ENDIF
195 IF(ismstr==1)THEN
196 DO i=jft,jlt
197 IF(offg(i)==one)offg(i)=two
198 ENDDO
199 ENDIF
200C----------------------------
201C ORTHOTROPY (plus tard)
202C----------------------------
203 IF (irep > 0) THEN
204 CALL cortdir3(elbuf_str,dir_a,dir_b ,jft ,jlt ,
205 . nlay ,irep ,rx ,ry ,rz ,
206 . sx ,sy ,ssz ,r11 ,r21 ,
207 . r31 ,r12 ,r22 ,r32 ,nel )
208 ENDIF
209
210 DO i=jft,jlt
211 lxyz0(1)=fourth*(xl2(i)+xl3(i)+xl4(i))
212 lxyz0(2)=fourth*(yl2(i)+yl3(i)+yl4(i))
213 corelv(i,1,1)=-lxyz0(1)
214 corelv(i,1,2)=xl2(i)-lxyz0(1)
215 corelv(i,1,3)=xl3(i)-lxyz0(1)
216 corelv(i,1,4)=xl4(i)-lxyz0(1)
217 corelv(i,2,1)=-lxyz0(2)
218 corelv(i,2,2)=yl2(i)-lxyz0(2)
219 corelv(i,2,3)=yl3(i)-lxyz0(2)
220 corelv(i,2,4)=yl4(i)-lxyz0(2)
221 x13(i)=(corelv(i,1,1)-corelv(i,1,3))*half
222 x24(i)=(corelv(i,1,2)-corelv(i,1,4))*half
223 y13(i)=(corelv(i,2,1)-corelv(i,2,3))*half
224 y24(i)=(corelv(i,2,2)-corelv(i,2,4))*half
225C
226 mx13(i)=(corelv(i,1,1)+corelv(i,1,3))*half
227 mx23(i)=(corelv(i,1,2)+corelv(i,1,3))*half
228 mx34(i)=(corelv(i,1,3)+corelv(i,1,4))*half
229 my13(i)=(corelv(i,2,1)+corelv(i,2,3))*half
230 my23(i)=(corelv(i,2,2)+corelv(i,2,3))*half
231 my34(i)=(corelv(i,2,3)+corelv(i,2,4))*half
232C
233 x13_2(i) =x13(i)*x13(i)
234 y13_2(i) =y13(i)*y13(i)
235 x24_2(i) =x24(i)*x24(i)
236 y24_2(i) =y24(i)*y24(i)
237 l13(i)=x13_2(i)+y13_2(i)
238 l24(i)=x24_2(i)+y24_2(i)
239 ll(i)=half*(l13(i)+l24(i))
240 s1=em01*thk(i)*thk(i)
241 ll(i)=max(ll(i),s1)
242 ENDDO
243 IF (imp_chk > 0) THEN
244 s1 =.577350269189626
245 DO i=jft,jlt
246 j1=(mx23(i)*my13(i)-mx13(i)*my23(i))*s1
247 j2=-(mx13(i)*my34(i)-mx34(i)*my13(i))*s1
248 j0=area(i)*fourth
249 xx1=j0+j2-j1
250 xx2=j0+j2+j1
251 xx3=j0-j2+j1
252 xx4=j0-j2-j1
253 IF(offg(i)/=zero)THEN
254 IF(xx1<=zero.OR.xx2<=zero.OR.
255 . xx3<=zero.OR.xx4<=zero)THEN
256#include "lockon.inc"
257 WRITE(iout ,2001) ngl(i)
258#include "lockoff.inc"
259 idel7nok = 1
260 imp_ir = imp_ir + 1
261 ENDIF
262 ENDIF
263 ENDDO
264 ENDIF
265C--------------------------
266 DO i=jft,jlt
267 z2(i)=z1(i)*z1(i)
268 IF (z2(i)<ll(i)*tol.OR.npt==1) THEN
269 z1(i)=zero
270 ELSE
271C--------------------------------------------------
272C WARPING SPECIAL TREATMENT
273C full projection eliminer drilling rotations and rigid rotations
274C--------------------------------------------------------------------------
275 a_4=area(i)*fourth
276C---------- node N ----------
277 sz1=mx13(i)*y24(i)-my13(i)*x24(i)
278 sz2=a_4+sz1
279 sz=z2(i)*l24(i)
280 sl=one/sqrt(sz+sz2*sz2)
281 vqn(i,1,1)=-z1(i)*y24(i)
282 vqn(i,2,1)= z1(i)*x24(i)
283 vqn(i,3,1)= sz2*sl
284 vqn(i,1,3)=-vqn(i,1,1)
285 vqn(i,2,3)=-vqn(i,2,1)
286 vqn(i,1,1)= vqn(i,1,1)*sl
287 vqn(i,2,1)= vqn(i,2,1)*sl
288C
289 sz2=a_4-sz1
290 sl=one/sqrt(sz+sz2*sz2)
291 vqn(i,1,3)= vqn(i,1,3)*sl
292 vqn(i,2,3)= vqn(i,2,3)*sl
293 vqn(i,3,3)= sz2*sl
294C
295 sz1=mx13(i)*y13(i)-my13(i)*x13(i)
296 sz2=a_4+sz1
297 sz=z2(i)*l13(i)
298 sl=one/sqrt(sz+sz2*sz2)
299 vqn(i,1,2)=-z1(i)*y13(i)
300 vqn(i,2,2)= z1(i)*x13(i)
301 vqn(i,3,2)= sz2*sl
302 vqn(i,1,4)=-vqn(i,1,2)
303 vqn(i,2,4)=-vqn(i,2,2)
304 vqn(i,1,2)= vqn(i,1,2)*sl
305 vqn(i,2,2)= vqn(i,2,2)*sl
306C
307 sz2=a_4-sz1
308 sl=one/sqrt(sz+sz2*sz2)
309 vqn(i,1,4)= vqn(i,1,4)*sl
310 vqn(i,2,4)= vqn(i,2,4)*sl
311 vqn(i,3,4)= sz2*sl
312 ENDIF
313 ENDDO
314C
315 nplat=jft-1
316 splat= 0
317 DO i=jft,jlt
318 IF (z1(i)==zero) THEN
319 nplat=nplat+1
320 iplat(nplat)=i
321 ELSE
322 splat=splat+1
323 jplat(splat)=i
324 ENDIF
325 ENDDO
326 DO i=nplat+1,jlt
327 iplat(i)=jplat(i-nplat)
328 ENDDO
329C
330 DO i=jft,jlt
331 off(i)=offg(i)
332 ENDDO
333C
334 RETURN
335 2001 FORMAT(/' ZERO OR NEGATIVE SHELL SUB-AREA : ELEMENT NB:',i8/)
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
cortdir3
subroutine cortdir3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, rx, ry, rz, sx, sy, sz, e1x, e1y, e1z, e2x, e2y, e2z, nel)
Definition cortdir3.F:45
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21