OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbaproj_ply.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cbaproj_ply (jft, jlt, npt, nplat, iplat, vqn, vq, vf, vfi, corel, di, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, off)

Function/Subroutine Documentation

◆ cbaproj_ply()

subroutine cbaproj_ply ( integer jft,
integer jlt,
integer npt,
integer nplat,
integer, dimension(*) iplat,
vqn,
vq,
vf,
vfi,
corel,
di,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
off )

Definition at line 28 of file cbaproj_ply.F.

34C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
35C TRANSMET LES FORCES INTERNES LOCALES VF,VM ---> GLOBALES FIJ ,MIJ
36C ENTREES :
37C SORTIES : FIJ
38C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
39#include "implicit_f.inc"
40#include "mvsiz_p.inc"
41C-----------------------------------------------
42C D U M M Y A R G U M E N T S
43C-----------------------------------------------
44 INTEGER JFT,JLT,NPLAT ,IPLAT(*),NPT
45 my_real
46 . vqn(mvsiz,9,4),vf(mvsiz,12,npt),vq(mvsiz,3,3),
47 . corel(mvsiz,3,4),di(mvsiz,6)
48 my_real
49 . f11(mvsiz,npt), f12(mvsiz,npt), f13(mvsiz,npt),
50 . f14(mvsiz,npt), f21(mvsiz,npt), f22(mvsiz,npt),
51 . f23(mvsiz,npt), f24(mvsiz,npt), f31(mvsiz,npt),
52 . f32(mvsiz,npt), f33(mvsiz,npt), f34(mvsiz,npt),
53 . vfi(mvsiz,12,npt) ,off(*)
54C-----------------------------------------------
55C L O C A L V A R I A B L E S
56C-----------------------------------------------
57 INTEGER I, J, K,EP,I_INF,I_SUP,IPLY,NPLAT0
58 my_real
59 . mm(3,4),fl(3,4),ml(2,4),c1,z1,
60 . ar(3),ad(4),alr(3),ald(4),dbad(3),
61 . f1, f2,f3,fac,fac1,fac2,fac3,fl1,fl2,
62 . fl3,e33,g,nu
63 my_real
64 . ml11(mvsiz),ml12(mvsiz),ml13(mvsiz) ,ml14(mvsiz),ml21(mvsiz),
65 . ml22(mvsiz),ml23(mvsiz),ml24(mvsiz) ,ml31(mvsiz),ml32(mvsiz),
66 . ml33(mvsiz),ml34(mvsiz)
67C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
68!! NPLAT0 = JLT
69 nplat0 = nplat
70 DO j=1,npt
71#include "vectorize.inc"
72 DO ep=jft,nplat0
73 k=iplat(ep)
74C I=1
75 fl(1,1)= vf(k,1,j) + vf(k,7,j)
76 fl(1,2)= vf(k,4,j) + vf(k,10,j)
77 fl(1,3)= -vf(k,1,j) + vf(k,7,j)
78 fl(1,4)= -vf(k,4,j) + vf(k,10,j)
79C I=2
80 fl(2,1)= vf(k,2,j) + vf(k,8,j)
81 fl(2,2)= vf(k,5,j) + vf(k,11,j)
82 fl(2,3)= -vf(k,2,j) + vf(k,8,j)
83 fl(2,4)= -vf(k,5,j) + vf(k,11,j)
84C I =3
85 fl(3,1)= vf(k,3,j) + vf(k,9,j)
86 fl(3,2)= vf(k,6,j) + vf(k,12,j)
87 fl(3,3)= -vf(k,3,j) + vf(k,9,j)
88 fl(3,4)= -vf(k,6,j) + vf(k,12,j)
89C---------------------------------------
90C TRANS LOCAL-->GLOBAL ET 5DDL-->6DDL
91C---------------------------------------
92C
93C J=1
94C I=1
95 f11(k,j)= vq(k,1,1)*fl(1,1)+vq(k,1,2)*fl(2,1)+vq(k,1,3)*fl(3,1)
96C I=2
97 f21(k,j)= vq(k,2,1)*fl(1,1)+vq(k,2,2)*fl(2,1)+vq(k,2,3)*fl(3,1)
98C I=3
99 f31(k,j)= vq(k,3,1)*fl(1,1)+vq(k,3,2)*fl(2,1)+vq(k,3,3)*fl(3,1)
100C
101C J=2
102C I=1
103 f12(k,j)= vq(k,1,1)*fl(1,2)+vq(k,1,2)*fl(2,2)+vq(k,1,3)*fl(3,2)
104C I=2
105 f22(k,j)= vq(k,2,1)*fl(1,2)+vq(k,2,2)*fl(2,2)+vq(k,2,3)*fl(3,2)
106C I=3
107 f32(k,j)= vq(k,3,1)*fl(1,2)+vq(k,3,2)*fl(2,2)+vq(k,3,3)*fl(3,2)
108C
109C J=3
110C I=1
111 f13(k,j)= vq(k,1,1)*fl(1,3)+vq(k,1,2)*fl(2,3)+vq(k,1,3)*fl(3,3)
112C I=2
113 f23(k,j)= vq(k,2,1)*fl(1,3)+vq(k,2,2)*fl(2,3)+vq(k,2,3)*fl(3,3)
114C I=3
115 f33(k,j)= vq(k,3,1)*fl(1,3)+vq(k,3,2)*fl(2,3)+vq(k,3,3)*fl(3,3)
116C
117C J=4
118C I=1
119 f14(k,j)= vq(k,1,1)*fl(1,4)+vq(k,1,2)*fl(2,4)+vq(k,1,3)*fl(3,4)
120C I=2
121 f24(k,j)= vq(k,2,1)*fl(1,4)+vq(k,2,2)*fl(2,4)+vq(k,2,3)*fl(3,4)
122C I=3
123 f34(k,j)= vq(k,3,1)*fl(1,4)+vq(k,3,2)*fl(2,4)+vq(k,3,3)*fl(3,4)
124C
125
126 ENDDO
127#include "vectorize.inc"
128 DO ep=nplat0+1,jlt
129 k=iplat(ep)
130C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
131 z1 = corel(k,3,1)
132 ar(1)= -z1*(vf(k,2,j) - vf(k,5,j) + vf(k,8,j)-vf(k,11,j))
133 1 + corel(k,2,1)*vf(k,3,j)
134 2 + corel(k,2,2)*vf(k,6,j)
135 3 + corel(k,2,3)*vf(k,9,j)
136 4 + corel(k,2,4)*vf(k,12,j)
137 ar(2)= z1*(vf(k,1,j)-vf(k,4,j)+vf(k,7,j)-vf(k,10,j))
138 1 - corel(k,1,1)*vf(k,3,j)
139 2 - corel(k,1,2)*vf(k,6,j)
140 3 - corel(k,1,3)*vf(k,9,j)
141 4 - corel(k,1,4)*vf(k,12,j)
142 ar(3)=-corel(k,2,1)*vf(k,1,j)+corel(k,1,1)*vf(k,2,j)
143 1 -corel(k,2,2)*vf(k,4,j)+corel(k,1,2)*vf(k,5,j)
144 2 -corel(k,2,3)*vf(k,7,j)+corel(k,1,3)*vf(k,8,j)
145 3 -corel(k,2,4)*vf(k,10,j)+corel(k,1,4)*vf(k,11,j)
146C
147 alr(1) =di(k,1)*ar(1)+di(k,4)*ar(2)+di(k,5)*ar(3)
148 alr(2) =di(k,4)*ar(1)+di(k,2)*ar(2)+di(k,6)*ar(3)
149 alr(3) =di(k,5)*ar(1)+di(k,6)*ar(2)+di(k,3)*ar(3)
150C
151 c1 =z1*alr(2)
152 vf(k,1,j )= vf(k,1,j) - c1+corel(k,2,1)*alr(3)
153 vf(k,4,j )= vf(k,4,j) + c1+corel(k,2,2)*alr(3)
154 vf(k,7,j )= vf(k,7,j) - c1+corel(k,2,3)*alr(3)
155 vf(k,10,j)= vf(k,10,j) + c1+corel(k,2,4)*alr(3)
156C
157 c1 =z1*alr(1)
158 vf(k,2,j)= vf(k,2,j) +c1-corel(k,1,1)*alr(3)
159 vf(k,5,j)= vf(k,5,j) -c1-corel(k,1,2)*alr(3)
160 vf(k,8,j)= vf(k,8,j) +c1-corel(k,1,3)*alr(3)
161 vf(k,11,j)= vf(k,11,j)-c1-corel(k,1,4)*alr(3)
162C
163 vf(k,3,j) = vf(k,3,j) -corel(k,2,1)*alr(1)+corel(k,1,1)*alr(2)
164 vf(k,6,j) = vf(k,6,j) -corel(k,2,2)*alr(1)+corel(k,1,2)*alr(2)
165 vf(k,9,j) = vf(k,9,j) -corel(k,2,3)*alr(1)+corel(k,1,3)*alr(2)
166 vf(k,12,j)= vf(k,12,j)-corel(k,2,4)*alr(1)+corel(k,1,4)*alr(2)
167
168C I=1
169 f11(k,j)= vq(k,1,1)*vf(k,1,j) + vq(k,1,2)*vf(k,2,j)
170 1 + vq(k,1,3)*vf(k,3,j)
171C I=2
172 f21(k,j)= vq(k,2,1)*vf(k,1,j) + vq(k,2,2)*vf(k,2,j)
173 1 + vq(k,2,3)*vf(k,3,j)
174C I=3
175 f31(k,j)= vq(k,3,1)*vf(k,1,j) + vq(k,3,2)*vf(k,2,j)
176 1 + vq(k,3,3)*vf(k,3,j)
177C
178C J=2
179C I=1
180 f12(k,j)= vq(k,1,1)*vf(k,4,j) + vq(k,1,2)*vf(k,5,j)
181 1 + vq(k,1,3)*vf(k,6,j)
182C I=2
183 f22(k,j)= vq(k,2,1)*vf(k,4,j) + vq(k,2,2)*vf(k,5,j)
184 1 + vq(k,2,3)*vf(k,6,j)
185C I=3
186 f32(k,j)= vq(k,3,1)*vf(k,4,j) + vq(k,3,2)*vf(k,5,j)
187 1 + vq(k,3,3)*vf(k,6,j)
188C
189C J=3
190C I=1
191 f13(k,j)= vq(k,1,1)*vf(k,7,j) + vq(k,1,2)*vf(k,8,j)
192 1 + vq(k,1,3)*vf(k,9,j)
193C I=2
194 f23(k,j)= vq(k,2,1)*vf(k,7,j) + vq(k,2,2)*vf(k,8,j)
195 1 + vq(k,2,3)*vf(k,9,j)
196C I=3
197 f33(k,j)= vq(k,3,1)*vf(k,7,j) + vq(k,3,2)*vf(k,8,j)
198 1 + vq(k,3,3)*vf(k,9,j)
199C
200C J=4
201C I=1
202 f14(k,j)= vq(k,1,1)*vf(k,10,j)+ vq(k,1,2)*vf(k,11,j)
203 1 + vq(k,1,3)*vf(k,12,j)
204C I=2
205 f24(k,j)= vq(k,2,1)*vf(k,10,j)+ vq(k,2,2)*vf(k,11,j)
206 1 + vq(k,2,3)*vf(k,12,j)
207C I=3
208 f34(k,j)= vq(k,3,1)*vf(k,10,j)+ vq(k,3,2)*vf(k,11,j)
209 1 + vq(k,3,3)*vf(k,12,j)
210 ENDDO
211 ENDDO
212C
213C Projection des forces d'interpli
214 DO j = 1 , npt
215#include "vectorize.inc"
216 DO ep=jft,jlt
217 k=iplat(ep)
218
219 fl1 = vfi(k,1,j)
220 fl2 = vfi(k,2,j)
221 fl3 = vfi(k,3,j)
222C transformation au repere globale
223 f1= vq(k,1,1)*fl1 + vq(k,1,2)*fl2
224 1 + vq(k,1,3)*fl3
225 f2= vq(k,2,1)*fl1 + vq(k,2,2)*fl2
226 1 + vq(k,2,3)*fl3
227 f3= vq(k,3,1)*fl1 + vq(k,3,2)*fl2
228 1 + vq(k,3,3)*fl3
229CNode 1 - ply
230 f11(k,j)= f11(k,j) + f1
231 f21(k,j)= f21(k,j) + f2
232 f31(k,j)= f31(k,j) + f3
233CNode 2 -ply
234 fl1 = vfi(k,4,j)
235 fl2 = vfi(k,5,j)
236 fl3 = vfi(k,6,j)
237C transformation au repere globale
238 f1= vq(k,1,1)*fl1 + vq(k,1,2)*fl2
239 1 + vq(k,1,3)*fl3
240 f2= vq(k,2,1)*fl1 + vq(k,2,2)*fl2
241 1 + vq(k,2,3)*fl3
242 f3= vq(k,3,1)*fl1 + vq(k,3,2)*fl2
243 1 + vq(k,3,3)*fl3
244 f12(k,j)= f12(k,j) + f1
245 f22(k,j)= f22(k,j) + f2
246 f32(k,j)= f32(k,j) + f3
247CC
248 fl1 = vfi(k,7,j)
249 fl2 = vfi(k,8,j)
250 fl3 = vfi(k,9,j)
251C transformation au repere globale
252 f1= vq(k,1,1)*fl1 + vq(k,1,2)*fl2
253 1 + vq(k,1,3)*fl3
254 f2= vq(k,2,1)*fl1 + vq(k,2,2)*fl2
255 1 + vq(k,2,3)*fl3
256 f3= vq(k,3,1)*fl1 + vq(k,3,2)*fl2
257 1 + vq(k,3,3)*fl3
258CNode 3 - ply
259 f13(k,j)= f13(k,j) + f1
260 f23(k,j)= f23(k,j) + f2
261 f33(k,j)= f33(k,j) + f3
262CNode 4 -ply
263 fl1 = vfi(k,10,j)
264 fl2 = vfi(k,11,j)
265 fl3 = vfi(k,12,j)
266C transformation au repere globale
267 f1= vq(k,1,1)*fl1 + vq(k,1,2)*fl2
268 1 + vq(k,1,3)*fl3
269 f2= vq(k,2,1)*fl1 + vq(k,2,2)*fl2
270 1 + vq(k,2,3)*fl3
271 f3= vq(k,3,1)*fl1 + vq(k,3,2)*fl2
272 1 + vq(k,3,3)*fl3
273 f14(k,j)= f14(k,j) + f1
274 f24(k,j)= f24(k,j) + f2
275 f34(k,j)= f34(k,j) + f3
276C
277CNode 1 - ply
278 f11(k,j)= f11(k,j)*off(k)
279 f21(k,j)= f21(k,j)*off(k)
280 f31(k,j)= f31(k,j)*off(k)
281CNode 2 - ply
282 f12(k,j)= f12(k,j)*off(k)
283 f22(k,j)= f22(k,j)*off(k)
284 f32(k,j)= f32(k,j)*off(k)
285CNode 3 - ply
286 f13(k,j)= f13(k,j)*off(k)
287 f23(k,j)= f23(k,j)*off(k)
288 f33(k,j)= f33(k,j)*off(k)
289CNode 4 - ply
290 f14(k,j)= f14(k,j)*off(k)
291 f24(k,j)= f24(k,j)*off(k)
292 f34(k,j)= f34(k,j)*off(k)
293
294 ENDDO
295 ENDDO
296 RETURN
my_real
#define my_real
Definition cppsort.cpp:32