OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_bcs.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!|| lag_bcs ../engine/source/tools/lagmul/lag_bcs.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- uses -----------------------------------------------------
28!|| groupdef_mod ../common_source/modules/groupdef_mod.F
29!||====================================================================
30 SUBROUTINE lag_bcs(IGRNOD ,IBCSLAG,SK ,RLL ,NGRNOD ,
31 2 IADLL ,LLL ,JLL ,SLL ,XLL ,
32 3 COMNTAG,ICFTAG ,JCFTAG ,MASS ,INER ,
33 4 V ,VR ,A ,AR ,ISKIP ,
34 5 NCF_S ,NC )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE groupdef_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com08_c.inc"
47#include "lagmult.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NC, ISKIP,NCF_S,NGRNOD,
53 . IBCSLAG(5,*),IADLL(*),
54 . SLL(*),LLL(*),JLL(*),COMNTAG(*),ICFTAG(*),JCFTAG(*)
55 my_real
56 . xll(*),rll(*),sk(lskew,*),mass(*),iner(*),v(3,*),vr(3,*),
57 . a(3,*),ar(3,*)
58!
59 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,IC,IG,IK,IGR,IS,NN,CT,CR
64 my_real
65 . AA,VV,HH,R,SK1,SK2,SK3,DTM2
66C-----------------------------------------------
67C NC : nombre de condition cinematique
68C IC : numero de la condition cinematique (1,NC)
69C IK :
70C I : numero global du noeud (1,NUMNOD)
71C J : direction 1,2,3,4,5,6
72C------
73C IADLL(NC) : IAD = IADLL(IC)
74C IK = IAD,IAD+1,IAD+2,...
75C LLL(LAG_NKF) : I = LLL(IK)
76C JLL(LAG_NKF) : J = JLL(IK)
77C======================================================================|
78 dtm2 = one / (dt2*dt12)
79 DO i=1,nbcslag
80 igr = ibcslag(1,i)
81 ct = ibcslag(2,i)
82 cr = ibcslag(3,i)
83 is = ibcslag(4,i)
84 DO ig=1,igrnod(igr)%NENTITY
85 nn=igrnod(igr)%ENTITY(ig)
86 IF (comntag(nn)>1) THEN
87 IF(mass(nn)/=zero)THEN
88C--- Translations
89 IF(ct==1.OR.ct==3.OR.ct==5.OR.ct==7)THEN
90C--- dz
91 nc = nc + 1
92 ic = nc - ncf_s
93 icftag(ic) = ic + iskip
94 jcftag(ic+iskip) = nc
95 IF(is==1)THEN
96 iadll(nc+1)=iadll(nc) + 1
97 ik = iadll(nc)
98 lll(ik) = nn
99 jll(ik) = 3
100 sll(ik) = 0
101 xll(ik) = one
102c RLL(NC) = -DX(3,NN) * DTM2
103c print*,'RLL(',NC,') =',RLL(NC), DX(3,NN)
104 a(3,nn) = -v(3,nn)/dt12
105 ELSE
106 sk1 = sk(7,is)
107 sk2 = sk(8,is)
108 sk3 = sk(9,is)
109 iadll(nc+1)=iadll(nc) + 3
110 ik = iadll(nc)
111 lll(ik) = nn
112 jll(ik) = 1
113 sll(ik) = 0
114 xll(ik) = sk1
115 ik = ik + 1
116 lll(ik) = nn
117 jll(ik) = 2
118 sll(ik) = 0
119 xll(ik) = sk2
120 ik = ik + 1
121 lll(ik) = nn
122 jll(ik) = 3
123 sll(ik) = 0
124 xll(ik) = sk3
125 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
126 r = sk1*(v(1,nn)/dt12 + a(1,nn))
127 . + sk2*(v(2,nn)/dt12 + a(2,nn))
128 . + sk3*(v(3,nn)/dt12 + a(3,nn))
129 r = r / hh
130 a(1,nn) = a(1,nn) - sk1*r
131 a(2,nn) = a(2,nn) - sk2*r
132 a(3,nn) = a(3,nn) - sk3*r
133 ENDIF
134 ENDIF
135 IF(ct==2.OR.ct==3.OR.ct==6.OR.ct==7)THEN
136C--- dy
137 nc = nc + 1
138 ic = nc - ncf_s
139 icftag(ic) = ic + iskip
140 jcftag(ic+iskip) = nc
141 IF(is==1)THEN
142 iadll(nc+1)=iadll(nc) + 1
143 ik = iadll(nc)
144 lll(ik) = nn
145 jll(ik) = 2
146 sll(ik) = 0
147 xll(ik) = one
148c RLL(NC) = -DX(2,NN) * DTM2
149c print*,'RLL(',NC,') =',RLL(NC), DX(2,NN)
150 a(2,nn) = -v(2,nn)/dt12
151 ELSE
152 sk1 = sk(4,is)
153 sk2 = sk(5,is)
154 sk3 = sk(6,is)
155 iadll(nc+1)=iadll(nc) + 3
156 ik = iadll(nc)
157 lll(ik) = nn
158 jll(ik) = 1
159 sll(ik) = 0
160 xll(ik) = sk1
161 ik = ik + 1
162 lll(ik) = nn
163 jll(ik) = 2
164 sll(ik) = 0
165 xll(ik) = sk2
166 ik = ik + 1
167 lll(ik) = nn
168 jll(ik) = 3
169 sll(ik) = 0
170 xll(ik) = sk3
171 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
172 r = sk1*(v(1,nn)/dt12 + a(1,nn))
173 . + sk2*(v(2,nn)/dt12 + a(2,nn))
174 . + sk3*(v(3,nn)/dt12 + a(3,nn))
175 r = r / hh
176 a(1,nn) = a(1,nn) - sk1*r
177 a(2,nn) = a(2,nn) - sk2*r
178 a(3,nn) = a(3,nn) - sk3*r
179 ENDIF
180 ENDIF
181 IF(ct==4.OR.ct==5.OR.ct==6.OR.ct==7)THEN
182C--- dx
183 nc = nc + 1
184 ic = nc - ncf_s
185 icftag(ic) = ic + iskip
186 jcftag(ic+iskip) = nc
187 IF(is==1)THEN
188 iadll(nc+1)=iadll(nc) + 1
189 ik = iadll(nc)
190 lll(ik) = nn
191 jll(ik) = 1
192 sll(ik) = 0
193 xll(ik) = one
194c RLL(NC) = -DX(1,NN) * DTM2
195c print*,'RLL(',NC,') =',RLL(NC), DX(1,NN)
196 a(1,nn) = -v(1,nn)/dt12
197 ELSE
198 sk1 = sk(1,is)
199 sk2 = sk(2,is)
200 sk3 = sk(3,is)
201 iadll(nc+1)=iadll(nc) + 3
202 ik = iadll(nc)
203 lll(ik) = nn
204 jll(ik) = 1
205 sll(ik) = 0
206 xll(ik) = sk1
207 ik = ik + 1
208 lll(ik) = nn
209 jll(ik) = 2
210 sll(ik) = 0
211 xll(ik) = sk2
212 ik = ik + 1
213 lll(ik) = nn
214 jll(ik) = 3
215 sll(ik) = 0
216 xll(ik) = sk3
217 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
218 r = sk1*(v(1,nn)/dt12 + a(1,nn))
219 . + sk2*(v(2,nn)/dt12 + a(2,nn))
220 . + sk3*(v(3,nn)/dt12 + a(3,nn))
221 r = r / hh
222 a(1,nn) = a(1,nn) - sk1*r
223 a(2,nn) = a(2,nn) - sk2*r
224 a(3,nn) = a(3,nn) - sk3*r
225 ENDIF
226 ENDIF
227 ENDIF
228 IF(iner(nn)/=zero)THEN
229C--- Rotations
230 IF(cr==1.OR.cr==3.OR.cr==5.OR.cr==7)THEN
231C--- rz
232 nc = nc + 1
233 ic = nc - ncf_s
234 icftag(ic) = ic + iskip
235 jcftag(ic+iskip) = nc
236 IF(is==1)THEN
237 iadll(nc+1)=iadll(nc) + 1
238 ik = iadll(nc)
239 lll(ik) = nn
240 jll(ik) = 6
241 sll(ik) = 0
242 xll(ik) = one
243c RLL(NC) = -DR(3,NN) * DTM2
244c print*,'RLL(',NC,') =',RLL(NC), DR(3,NN)
245 ar(3,nn) = -vr(3,nn)/dt12
246 ELSE
247 sk1 = sk(7,is)
248 sk2 = sk(8,is)
249 sk3 = sk(9,is)
250 iadll(nc+1)=iadll(nc) + 3
251 ik = iadll(nc)
252 lll(ik) = nn
253 jll(ik) = 4
254 sll(ik) = 0
255 xll(ik) = sk1
256 ik = ik + 1
257 lll(ik) = nn
258 jll(ik) = 5
259 sll(ik) = 0
260 xll(ik) = sk2
261 ik = ik + 1
262 lll(ik) = nn
263 jll(ik) = 6
264 sll(ik) = 0
265 xll(ik) = sk3
266 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
267 r = sk1*(vr(1,nn)/dt12 + ar(1,nn))
268 . + sk2*(vr(2,nn)/dt12 + ar(2,nn))
269 . + sk3*(vr(3,nn)/dt12 + ar(3,nn))
270 r = r / hh
271 ar(1,nn) = ar(1,nn) - sk1*r
272 ar(2,nn) = ar(2,nn) - sk2*r
273 ar(3,nn) = ar(3,nn) - sk3*r
274 ENDIF
275 ENDIF
276 IF(cr==2.OR.cr==3.OR.cr==6.OR.cr==7)THEN
277C--- ry
278 nc = nc + 1
279 ic = nc - ncf_s
280 icftag(ic) = ic + iskip
281 jcftag(ic+iskip) = nc
282 IF(is==1)THEN
283 iadll(nc+1)=iadll(nc) + 1
284 ik = iadll(nc)
285 lll(ik) = nn
286 jll(ik) = 5
287 sll(ik) = 0
288 xll(ik) = one
289c RLL(NC) = -DR(2,NN) * DTM2
290c print*,'RLL(',NC,') =',RLL(NC), DR(2,NN)
291 ar(2,nn) = -vr(2,nn)/dt12
292 ELSE
293 sk1 = sk(4,is)
294 sk2 = sk(5,is)
295 sk3 = sk(6,is)
296 iadll(nc+1)=iadll(nc) + 3
297 ik = iadll(nc)
298 lll(ik) = nn
299 jll(ik) = 4
300 sll(ik) = 0
301 xll(ik) = sk1
302 ik = ik + 1
303 lll(ik) = nn
304 jll(ik) = 5
305 sll(ik) = 0
306 xll(ik) = sk2
307 ik = ik + 1
308 lll(ik) = nn
309 jll(ik) = 6
310 sll(ik) = 0
311 xll(ik) = sk3
312 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
313 r = sk1*(vr(1,nn)/dt12 + ar(1,nn))
314 . + sk2*(vr(2,nn)/dt12 + ar(2,nn))
315 . + sk3*(vr(3,nn)/dt12 + ar(3,nn))
316 r = r / hh
317 ar(1,nn) = ar(1,nn) - sk1*r
318 ar(2,nn) = ar(2,nn) - sk2*r
319 ar(3,nn) = ar(3,nn) - sk3*r
320 ENDIF
321 ENDIF
322 IF(cr==4.OR.cr==5.OR.cr==6.OR.cr==7)THEN
323C--- rx
324 nc = nc + 1
325 ic = nc - ncf_s
326 icftag(ic) = ic + iskip
327 jcftag(ic+iskip) = nc
328 IF(is==1)THEN
329 iadll(nc+1)=iadll(nc) + 1
330 ik = iadll(nc)
331 lll(ik) = nn
332 jll(ik) = 4
333 sll(ik) = 0
334 xll(ik) = one
335c RLL(NC) = -DR(1,NN) * DTM2
336c print*,'RLL(',NC,') =',RLL(NC), DR(1,NN)
337 ar(1,nn) = -vr(1,nn)/dt12
338 ELSE
339 sk1 = sk(1,is)
340 sk2 = sk(2,is)
341 sk3 = sk(3,is)
342 iadll(nc+1)=iadll(nc) + 3
343 ik = iadll(nc)
344 lll(ik) = nn
345 jll(ik) = 4
346 sll(ik) = 0
347 xll(ik) = sk1
348 ik = ik + 1
349 lll(ik) = nn
350 jll(ik) = 5
351 sll(ik) = 0
352 xll(ik) = sk2
353 ik = ik + 1
354 lll(ik) = nn
355 jll(ik) = 6
356 sll(ik) = 0
357 xll(ik) = sk3
358 hh = sk1*sk1 + sk2*sk2 + sk3*sk3
359 r = sk1*(vr(1,nn)/dt12 + ar(1,nn))
360 . + sk2*(vr(2,nn)/dt12 + ar(2,nn))
361 . + sk3*(vr(3,nn)/dt12 + ar(3,nn))
362 r = r / hh
363 ar(1,nn) = ar(1,nn) - sk1*r
364 ar(2,nn) = ar(2,nn) - sk2*r
365 ar(3,nn) = ar(3,nn) - sk3*r
366 ENDIF
367 ENDIF
368 ENDIF
369C--- Direct solution
370 ELSE
371 IF(is==1) THEN
372C---- REPERE GLOBAL
373 IF(ct==1)THEN
374 v(3,nn)=zero
375 a(3,nn)=zero
376 iskip = iskip + 1
377 ELSEIF(ct==2)THEN
378 v(2,nn)=zero
379 a(2,nn)=zero
380 iskip = iskip + 1
381 ELSEIF(ct==3)THEN
382 v(2,nn)=zero
383 v(3,nn)=zero
384 a(2,nn)=zero
385 a(3,nn)=zero
386 iskip = iskip + 2
387 ELSEIF(ct==4)THEN
388 v(1,nn)=zero
389 a(1,nn)=zero
390 iskip = iskip + 1
391 ELSEIF(ct==5)THEN
392 v(1,nn)=zero
393 v(3,nn)=zero
394 a(1,nn)=zero
395 a(3,nn)=zero
396 iskip = iskip + 2
397 ELSEIF(ct==6)THEN
398 v(1,nn)=zero
399 v(2,nn)=zero
400 a(1,nn)=zero
401 a(2,nn)=zero
402 iskip = iskip + 2
403 ELSEIF(ct==7)THEN
404 v(1,nn)=zero
405 v(2,nn)=zero
406 v(3,nn)=zero
407 a(1,nn)=zero
408 a(2,nn)=zero
409 a(3,nn)=zero
410 iskip = iskip + 3
411 ENDIF
412 IF(cr==1)THEN
413 vr(3,nn)=zero
414 ar(3,nn)=zero
415 iskip = iskip + 1
416 ELSEIF(cr==2)THEN
417 vr(2,nn)=zero
418 ar(2,nn)=zero
419 iskip = iskip + 1
420 ELSEIF(cr==3)THEN
421 vr(2,nn)=zero
422 vr(3,nn)=zero
423 ar(2,nn)=zero
424 ar(3,nn)=zero
425 iskip = iskip + 2
426 ELSEIF(cr==4)THEN
427 vr(1,nn)=zero
428 ar(1,nn)=zero
429 iskip = iskip + 1
430 ELSEIF(cr==5)THEN
431 vr(1,nn)=zero
432 vr(3,nn)=zero
433 ar(1,nn)=zero
434 ar(3,nn)=zero
435 iskip = iskip + 2
436 ELSEIF(cr==6)THEN
437 vr(1,nn)=zero
438 vr(2,nn)=zero
439 ar(1,nn)=zero
440 ar(2,nn)=zero
441 iskip = iskip + 2
442 ELSEIF(cr==7)THEN
443 vr(1,nn)=zero
444 vr(2,nn)=zero
445 vr(3,nn)=zero
446 ar(1,nn)=zero
447 ar(2,nn)=zero
448 ar(3,nn)=zero
449 iskip = iskip + 3
450 ENDIF
451 ELSE
452C--- REPERE OBLIQUE
453 IF(ct==1)THEN
454 aa=sk(7,is)*a(1,nn)+sk(8,is)*a(2,nn)+sk(9,is)*a(3,nn)
455 vv=sk(7,is)*v(1,nn)+sk(8,is)*v(2,nn)+sk(9,is)*v(3,nn)
456 a(1,nn)=a(1,nn)-sk(7,is)*aa
457 a(2,nn)=a(2,nn)-sk(8,is)*aa
458 a(3,nn)=a(3,nn)-sk(9,is)*aa
459 v(1,nn)=v(1,nn)-sk(7,is)*vv
460 v(2,nn)=v(2,nn)-sk(8,is)*vv
461 v(3,nn)=v(3,nn)-sk(9,is)*vv
462 ELSEIF(ct==2)THEN
463 aa=sk(4,is)*a(1,nn)+sk(5,is)*a(2,nn)+sk(6,is)*a(3,nn)
464 vv=sk(4,is)*v(1,nn)+sk(5,is)*v(2,nn)+sk(6,is)*v(3,nn)
465 a(1,nn)=a(1,nn)-sk(4,is)*aa
466 a(2,nn)=a(2,nn)-sk(5,is)*aa
467 a(3,nn)=a(3,nn)-sk(6,is)*aa
468 v(1,nn)=v(1,nn)-sk(4,is)*vv
469 v(2,nn)=v(2,nn)-sk(5,is)*vv
470 v(3,nn)=v(3,nn)-sk(6,is)*vv
471 ELSEIF(ct==3)THEN
472 aa=sk(7,is)*a(1,nn)+sk(8,is)*a(2,nn)+sk(9,is)*a(3,nn)
473 vv=sk(7,is)*v(1,nn)+sk(8,is)*v(2,nn)+sk(9,is)*v(3,nn)
474 a(1,nn)=a(1,nn)-sk(7,is)*aa
475 a(2,nn)=a(2,nn)-sk(8,is)*aa
476 a(3,nn)=a(3,nn)-sk(9,is)*aa
477 v(1,nn)=v(1,nn)-sk(7,is)*vv
478 v(2,nn)=v(2,nn)-sk(8,is)*vv
479 v(3,nn)=v(3,nn)-sk(9,is)*vv
480 aa=sk(4,is)*a(1,nn)+sk(5,is)*a(2,nn)+sk(6,is)*a(3,nn)
481 vv=sk(4,is)*v(1,nn)+sk(5,is)*v(2,nn)+sk(6,is)*v(3,nn)
482 a(1,nn)=a(1,nn)-sk(4,is)*aa
483 a(2,nn)=a(2,nn)-sk(5,is)*aa
484 a(3,nn)=a(3,nn)-sk(6,is)*aa
485 v(1,nn)=v(1,nn)-sk(4,is)*vv
486 v(2,nn)=v(2,nn)-sk(5,is)*vv
487 v(3,nn)=v(3,nn)-sk(6,is)*vv
488 ELSEIF(ct==4)THEN
489 aa =sk(1,is)*a(1,nn)+sk(2,is)*a(2,nn)+sk(3,is)*a(3,nn)
490 vv =sk(1,is)*v(1,nn)+sk(2,is)*v(2,nn)+sk(3,is)*v(3,nn)
491 a(1,nn)=a(1,nn)-sk(1,is)*aa
492 a(2,nn)=a(2,nn)-sk(2,is)*aa
493 a(3,nn)=a(3,nn)-sk(3,is)*aa
494 v(1,nn)=v(1,nn)-sk(1,is)*vv
495 v(2,nn)=v(2,nn)-sk(2,is)*vv
496 v(3,nn)=v(3,nn)-sk(3,is)*vv
497 ELSEIF(ct==5)THEN
498 aa=sk(7,is)*a(1,nn)+sk(8,is)*a(2,nn)+sk(9,is)*a(3,nn)
499 vv=sk(7,is)*v(1,nn)+sk(8,is)*v(2,nn)+sk(9,is)*v(3,nn)
500 a(1,nn)=a(1,nn)-sk(7,is)*aa
501 a(2,nn)=a(2,nn)-sk(8,is)*aa
502 a(3,nn)=a(3,nn)-sk(9,is)*aa
503 v(1,nn)=v(1,nn)-sk(7,is)*vv
504 v(2,nn)=v(2,nn)-sk(8,is)*vv
505 v(3,nn)=v(3,nn)-sk(9,is)*vv
506 aa=sk(1,is)*a(1,nn)+sk(2,is)*a(2,nn)+sk(3,is)*a(3,nn)
507 vv=sk(1,is)*v(1,nn)+sk(2,is)*v(2,nn)+sk(3,is)*v(3,nn)
508 a(1,nn)=a(1,nn)-sk(1,is)*aa
509 a(2,nn)=a(2,nn)-sk(2,is)*aa
510 a(3,nn)=a(3,nn)-sk(3,is)*aa
511 v(1,nn)=v(1,nn)-sk(1,is)*vv
512 v(2,nn)=v(2,nn)-sk(2,is)*vv
513 v(3,nn)=v(3,nn)-sk(3,is)*vv
514 ELSEIF(ct==6)THEN
515 aa=sk(1,is)*a(1,nn)+sk(2,is)*a(2,nn)+sk(3,is)*a(3,nn)
516 vv=sk(1,is)*v(1,nn)+sk(2,is)*v(2,nn)+sk(3,is)*v(3,nn)
517 a(1,nn)=a(1,nn)-sk(1,is)*aa
518 a(2,nn)=a(2,nn)-sk(2,is)*aa
519 a(3,nn)=a(3,nn)-sk(3,is)*aa
520 v(1,nn)=v(1,nn)-sk(1,is)*vv
521 v(2,nn)=v(2,nn)-sk(2,is)*vv
522 v(3,nn)=v(3,nn)-sk(3,is)*vv
523 aa=sk(4,is)*a(1,nn)+sk(5,is)*a(2,nn)+sk(6,is)*a(3,nn)
524 vv=sk(4,is)*v(1,nn)+sk(5,is)*v(2,nn)+sk(6,is)*v(3,nn)
525 a(1,nn)=a(1,nn)-sk(4,is)*aa
526 a(2,nn)=a(2,nn)-sk(5,is)*aa
527 a(3,nn)=a(3,nn)-sk(6,is)*aa
528 v(1,nn)=v(1,nn)-sk(4,is)*vv
529 v(2,nn)=v(2,nn)-sk(5,is)*vv
530 v(3,nn)=v(3,nn)-sk(6,is)*vv
531 ELSEIF(ct==7)THEN
532 a(1,nn)=zero
533 a(2,nn)=zero
534 a(3,nn)=zero
535 v(1,nn)=zero
536 v(2,nn)=zero
537 v(3,nn)=zero
538 ENDIF
539 IF(ct==1)THEN
540 aa =sk(7,is)*ar(1,nn)+sk(8,is)*ar(2,nn)+sk(9,is)*ar(3,nn)
541 vv =sk(7,is)*vr(1,nn)+sk(8,is)*vr(2,nn)+sk(9,is)*vr(3,nn)
542 ar(1,nn)=ar(1,nn)-sk(7,is)*aa
543 ar(2,nn)=ar(2,nn)-sk(8,is)*aa
544 ar(3,nn)=ar(3,nn)-sk(9,is)*aa
545 vr(1,nn)=vr(1,nn)-sk(7,is)*vv
546 vr(2,nn)=vr(2,nn)-sk(8,is)*vv
547 vr(3,nn)=vr(3,nn)-sk(9,is)*vv
548 ELSEIF(ct==2)THEN
549 aa =sk(4,is)*ar(1,nn)+sk(5,is)*ar(2,nn)+sk(6,is)*ar(3,nn)
550 vv =sk(4,is)*vr(1,nn)+sk(5,is)*vr(2,nn)+sk(6,is)*vr(3,nn)
551 ar(1,nn)=ar(1,nn)-sk(4,is)*aa
552 ar(2,nn)=ar(2,nn)-sk(5,is)*aa
553 ar(3,nn)=ar(3,nn)-sk(6,is)*aa
554 vr(1,nn)=vr(1,nn)-sk(4,is)*vv
555 vr(2,nn)=vr(2,nn)-sk(5,is)*vv
556 vr(3,nn)=vr(3,nn)-sk(6,is)*vv
557 ELSEIF(ct==3)THEN
558 aa =sk(7,is)*ar(1,nn)+sk(8,is)*ar(2,nn)+sk(9,is)*ar(3,nn)
559 vv =sk(7,is)*vr(1,nn)+sk(8,is)*vr(2,nn)+sk(9,is)*vr(3,nn)
560 ar(1,nn)=ar(1,nn)-sk(7,is)*aa
561 ar(2,nn)=ar(2,nn)-sk(8,is)*aa
562 ar(3,nn)=ar(3,nn)-sk(9,is)*aa
563 vr(1,nn)=vr(1,nn)-sk(7,is)*vv
564 vr(2,nn)=vr(2,nn)-sk(8,is)*vv
565 vr(3,nn)=vr(3,nn)-sk(9,is)*vv
566 aa =sk(4,is)*ar(1,nn)+sk(5,is)*ar(2,nn)+sk(6,is)*ar(3,nn)
567 vv =sk(4,is)*vr(1,nn)+sk(5,is)*vr(2,nn)+sk(6,is)*vr(3,nn)
568 ar(1,nn)=ar(1,nn)-sk(4,is)*aa
569 ar(2,nn)=ar(2,nn)-sk(5,is)*aa
570 ar(3,nn)=ar(3,nn)-sk(6,is)*aa
571 vr(1,nn)=vr(1,nn)-sk(4,is)*vv
572 vr(2,nn)=vr(2,nn)-sk(5,is)*vv
573 vr(3,nn)=vr(3,nn)-sk(6,is)*vv
574 ELSEIF(ct==4)THEN
575 aa =sk(1,is)*ar(1,nn)+sk(2,is)*ar(2,nn)+sk(3,is)*ar(3,nn)
576 vv =sk(1,is)*vr(1,nn)+sk(2,is)*vr(2,nn)+sk(3,is)*vr(3,nn)
577 ar(1,nn)=ar(1,nn)-sk(1,is)*aa
578 ar(2,nn)=ar(2,nn)-sk(2,is)*aa
579 ar(3,nn)=ar(3,nn)-sk(3,is)*aa
580 vr(1,nn)=vr(1,nn)-sk(1,is)*vv
581 vr(2,nn)=vr(2,nn)-sk(2,is)*vv
582 vr(3,nn)=vr(3,nn)-sk(3,is)*vv
583 ELSEIF(ct==5)THEN
584 aa =sk(7,is)*ar(1,nn)+sk(8,is)*ar(2,nn)+sk(9,is)*ar(3,nn)
585 vv =sk(7,is)*vr(1,nn)+sk(8,is)*vr(2,nn)+sk(9,is)*vr(3,nn)
586 ar(1,nn)=ar(1,nn)-sk(7,is)*aa
587 ar(2,nn)=ar(2,nn)-sk(8,is)*aa
588 ar(3,nn)=ar(3,nn)-sk(9,is)*aa
589 vr(1,nn)=vr(1,nn)-sk(7,is)*vv
590 vr(2,nn)=vr(2,nn)-sk(8,is)*vv
591 vr(3,nn)=vr(3,nn)-sk(9,is)*vv
592 aa =sk(1,is)*ar(1,nn)+sk(2,is)*ar(2,nn)+sk(3,is)*ar(3,nn)
593 vv =sk(1,is)*vr(1,nn)+sk(2,is)*vr(2,nn)+sk(3,is)*vr(3,nn)
594 ar(1,nn)=ar(1,nn)-sk(1,is)*aa
595 ar(2,nn)=ar(2,nn)-sk(2,is)*aa
596 ar(3,nn)=ar(3,nn)-sk(3,is)*aa
597 vr(1,nn)=vr(1,nn)-sk(1,is)*vv
598 vr(2,nn)=vr(2,nn)-sk(2,is)*vv
599 vr(3,nn)=vr(3,nn)-sk(3,is)*vv
600 ELSEIF(ct==6)THEN
601 aa =sk(1,is)*ar(1,nn)+sk(2,is)*ar(2,nn)+sk(3,is)*ar(3,nn)
602 vv =sk(1,is)*vr(1,nn)+sk(2,is)*vr(2,nn)+sk(3,is)*vr(3,nn)
603 ar(1,nn)=ar(1,nn)-sk(1,is)*aa
604 ar(2,nn)=ar(2,nn)-sk(2,is)*aa
605 ar(3,nn)=ar(3,nn)-sk(3,is)*aa
606 vr(1,nn)=vr(1,nn)-sk(1,is)*vv
607 vr(2,nn)=vr(2,nn)-sk(2,is)*vv
608 vr(3,nn)=vr(3,nn)-sk(3,is)*vv
609 aa =sk(4,is)*ar(1,nn)+sk(5,is)*ar(2,nn)+sk(6,is)*ar(3,nn)
610 vv =sk(4,is)*vr(1,nn)+sk(5,is)*vr(2,nn)+sk(6,is)*vr(3,nn)
611 ar(1,nn)=ar(1,nn)-sk(4,is)*aa
612 ar(2,nn)=ar(2,nn)-sk(5,is)*aa
613 ar(3,nn)=ar(3,nn)-sk(6,is)*aa
614 vr(1,nn)=vr(1,nn)-sk(4,is)*vv
615 vr(2,nn)=vr(2,nn)-sk(5,is)*vv
616 vr(3,nn)=vr(3,nn)-sk(6,is)*vv
617 ELSEIF(ct==7)THEN
618 ar(1,nn)=zero
619 ar(2,nn)=zero
620 ar(3,nn)=zero
621 vr(1,nn)=zero
622 vr(2,nn)=zero
623 vr(3,nn)=zero
624 ENDIF
625 ENDIF
626 ENDIF
627C---
628 ENDDO
629 ENDDO
630C---
631 RETURN
632 END
lag_bcs
subroutine lag_bcs(igrnod, ibcslag, sk, rll, ngrnod, iadll, lll, jll, sll, xll, comntag, icftag, jcftag, mass, iner, v, vr, a, ar, iskip, ncf_s, nc)
Definition lag_bcs.F:35
groupdef_mod
Definition groupdef_mod.F:662