OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbe2f.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rbe2t1 (irbe2, lrbe2, x, a, ar, ms, in, skew, weight, iad_rbe2, fr_rbe2m, nmrbe2, stifn, stifr, r2size)
subroutine rbe2f (nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, irad)
subroutine rbe2fl (nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, skew, irad)
subroutine rbe2_poff (irbe2, a, ar, ms, in, stifn, stifr, weight, jr, ih)
subroutine rbe2_s (irbe2, a, ar, ms, in, stifn, stifr, weight, f6, m6, st6, sr6, jr, nmrbe2, ih)
subroutine prerbe2 (irbe2, jt, jr)
subroutine rbe2_init (irbe2, lrbe2, nmrbe2, fr_rbe2, fr_rbe2m, nfr)
subroutine rbe2frf (ns, m, a, ar, jt, jr, x, isk, skew0, irad)
subroutine rbe2flsn (nsl, isl, a, weight, ict, skew)
subroutine rbe2flsnfr (ns, a, ict, skew)
subroutine prerbe2fr (ic, jt, jr)

Function/Subroutine Documentation

◆ prerbe2()

subroutine prerbe2 ( integer, dimension(nrbe2l,*) irbe2,
integer, dimension(3,*) jt,
integer, dimension(3,*) jr )

Definition at line 541 of file rbe2f.F.

542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C C o m m o n B l o c k s
548C-----------------------------------------------
549#include "com01_c.inc"
550#include "com04_c.inc"
551#include "param_c.inc"
552C-----------------------------------------------
553C D u m m y A r g u m e n t s
554C-----------------------------------------------
555 INTEGER IRBE2(NRBE2L,*),JT(3,*) ,JR(3,*)
556C REAL
557C-----------------------------------------------
558C L o c a l V a r i a b l e s
559C-----------------------------------------------
560 INTEGER I, J, N,NML,IC,ICT,ICR,IROT
561C======================================================================|
562 DO n=1,nrbe2
563 ic=irbe2(4,n)
564 ict=ic/512
565 icr=(ic-512*(ict))/64
566 IF (iroddl==0) icr =0
567 DO j =1,3
568 jt(j,n)=0
569 jr(j,n)=0
570 ENDDO
571 SELECT CASE (ict)
572 CASE(1)
573 jt(3,n)=1
574 CASE(2)
575 jt(2,n)=1
576 CASE(3)
577 jt(2,n)=1
578 jt(3,n)=1
579 CASE(4)
580 jt(1,n)=1
581 CASE(5)
582 jt(1,n)=1
583 jt(3,n)=1
584 CASE(6)
585 jt(1,n)=1
586 jt(2,n)=1
587 CASE(7)
588 jt(1,n)=1
589 jt(2,n)=1
590 jt(3,n)=1
591 END SELECT
592 SELECT CASE (icr)
593 CASE(1)
594 jr(3,n)=1
595 CASE(2)
596 jr(2,n)=1
597 CASE(3)
598 jr(2,n)=1
599 jr(3,n)=1
600 CASE(4)
601 jr(1,n)=1
602 CASE(5)
603 jr(1,n)=1
604 jr(3,n)=1
605 CASE(6)
606 jr(1,n)=1
607 jr(2,n)=1
608 CASE(7)
609 jr(1,n)=1
610 jr(2,n)=1
611 jr(3,n)=1
612 END SELECT
613 ENDDO
614C---
615 RETURN

◆ prerbe2fr()

subroutine prerbe2fr ( integer ic,
integer, dimension(3) jt,
integer, dimension(3) jr )

Definition at line 1058 of file rbe2f.F.

1059C-----------------------------------------------
1060C I m p l i c i t T y p e s
1061C-----------------------------------------------
1062#include "implicit_f.inc"
1063C-----------------------------------------------
1064C D u m m y A r g u m e n t s
1065C-----------------------------------------------
1066 INTEGER IC,JT(3) ,JR(3)
1067C-----------------------------------------------
1068C L o c a l V a r i a b l e s
1069C-----------------------------------------------
1070 INTEGER I, J, NML,ICT,ICR
1071C======================================================================|
1072C IC=IRBE2(4,N)
1073 ict=ic/512
1074 icr=(ic-512*(ict))/64
1075 DO j =1,3
1076 jt(j)=0
1077 jr(j)=0
1078 ENDDO
1079 SELECT CASE (ict)
1080 CASE(1)
1081 jt(3)=1
1082 CASE(2)
1083 jt(2)=1
1084 CASE(3)
1085 jt(2)=1
1086 jt(3)=1
1087 CASE(4)
1088 jt(1)=1
1089 CASE(5)
1090 jt(1)=1
1091 jt(3)=1
1092 CASE(6)
1093 jt(1)=1
1094 jt(2)=1
1095 CASE(7)
1096 jt(1)=1
1097 jt(2)=1
1098 jt(3)=1
1099 END SELECT
1100 SELECT CASE (icr)
1101 CASE(1)
1102 jr(3)=1
1103 CASE(2)
1104 jr(2)=1
1105 CASE(3)
1106 jr(2)=1
1107 jr(3)=1
1108 CASE(4)
1109 jr(1)=1
1110 CASE(5)
1111 jr(1)=1
1112 jr(3)=1
1113 CASE(6)
1114 jr(1)=1
1115 jr(2)=1
1116 CASE(7)
1117 jr(1)=1
1118 jr(2)=1
1119 jr(3)=1
1120 END SELECT
1121C---
1122 RETURN

◆ rbe2_init()

subroutine rbe2_init ( integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nmrbe2,
integer, dimension(*) fr_rbe2,
integer, dimension(*) fr_rbe2m,
integer nfr )

Definition at line 622 of file rbe2f.F.

623C-----------------------------------------------
624C I m p l i c i t T y p e s
625C-----------------------------------------------
626#include "implicit_f.inc"
627C-----------------------------------------------
628C C o m m o n B l o c k s
629C-----------------------------------------------
630#include "com04_c.inc"
631#include "param_c.inc"
632C-----------------------------------------------
633C D u m m y A r g u m e n t s
634C-----------------------------------------------
635 INTEGER IRBE2(NRBE2L,*),LRBE2(*),NMRBE2,FR_RBE2(*),FR_RBE2M(*),NFR
636C REAL
637C-----------------------------------------------
638C L o c a l V a r i a b l e s
639C-----------------------------------------------
640 INTEGER I, J, M,N,ITAG(NUMNOD),IAD,IH(NRBE2),NSL,NS,NIH
641C======================================================================|
642 nmrbe2 = 0
643 IF (nrbe2==0) RETURN
644 DO n=1,numnod
645 itag(n)=0
646 ENDDO
647C-----s'il y a hierarchy----
648C DO N=1,NRBE2
649C M=IRBE2(3,N)
650C ITAG(M)=N
651C IH(N)=0
652C ENDDO
653C DO N=1,NRBE2
654C IAD=IRBE2(1,N)
655C M=IRBE2(3,N)
656C NSL =IRBE2(5,N)
657C DO J=1,NSL
658C NS= LRBE2(IAD+J)
659C IF (ITAG(NS)>0) IH(ITAG(NS)) =M
660C ENDDO
661C ENDDO
662C DO N=1,NRBE2
663C M=IRBE2(3,N)
664C ITAG(M)=0
665C ENDDO
666C
667 DO n=1,nrbe2
668 m=irbe2(3,n)
669 IF (itag(m)==0) THEN
670 nmrbe2 =nmrbe2 +1
671 itag(m)= nmrbe2
672 irbe2(6,n) = itag(m)
673 ih(nmrbe2) = irbe2(9,n)
674 ELSE
675 nih = ih(itag(m))
676 irbe2(6,n) = itag(m)
677C---------to avoid the double sum on A,AR for main nodes in the same IH
678 IF (irbe2(9,n)==nih) THEN
679 irbe2(6,n) = -itag(m)
680C---------case the same main in the same IH, but also before
681 ELSE
682 ih(itag(m)) = irbe2(9,n)
683 END IF
684 ENDIF
685 ENDDO
686C---
687 DO n=1,nfr
688 m=fr_rbe2(n)
689 fr_rbe2m(n)=itag(m)
690 ENDDO
691C
692 RETURN

◆ rbe2_poff()

subroutine rbe2_poff ( integer, dimension(nrbe2l,*) irbe2,
a,
ar,
ms,
in,
stifn,
stifr,
integer, dimension(*) weight,
integer, dimension(3,*) jr,
integer ih )

Definition at line 423 of file rbe2f.F.

425C-----------------------------------------------
426C I m p l i c i t T y p e s
427C-----------------------------------------------
428#include "implicit_f.inc"
429C-----------------------------------------------
430C C o m m o n B l o c k s
431C-----------------------------------------------
432#include "com04_c.inc"
433#include "param_c.inc"
434C-----------------------------------------------
435C D u m m y A r g u m e n t s
436C-----------------------------------------------
437 INTEGER IRBE2(NRBE2L,*),WEIGHT(*),JR(3,*),IH
438C REAL
439 my_real
440 . a(3,*), ar(3,*), ms(*), in(*) ,stifn(*) ,stifr(*)
441C-----------------------------------------------
442C L o c a l V a r i a b l e s
443C-----------------------------------------------
444 INTEGER I, K, N, NS ,NML, IAD,JJ,IROT,M
445C REAL
446C======================================================================|
447#include "vectorize.inc"
448 DO n=1,nrbe2
449 IF (irbe2(9,n)/=ih) cycle
450 m = irbe2(3,n)
451 a(1,m) = a(1,m)*weight(m)
452 a(2,m) = a(2,m)*weight(m)
453 a(3,m) = a(3,m)*weight(m)
454 stifn(m) = stifn(m)*weight(m)
455 irot = jr(1,n)+jr(2,n)+jr(3,n)
456 IF (irot>0) THEN
457 ar(1,m) = ar(1,m)*weight(m)
458 ar(2,m) = ar(2,m)*weight(m)
459 ar(3,m) = ar(3,m)*weight(m)
460 stifr(m) = stifr(m)*weight(m)
461 ENDIF
462 ENDDO
463C---
464 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ rbe2_s()

subroutine rbe2_s ( integer, dimension(nrbe2l,*) irbe2,
a,
ar,
ms,
in,
stifn,
stifr,
integer, dimension(*) weight,
double precision, dimension(3,6,*) f6,
double precision, dimension(3,6,*) m6,
double precision, dimension(6,*) st6,
double precision, dimension(6,*) sr6,
integer, dimension(3,*) jr,
integer nmrbe2,
integer ih )

Definition at line 471 of file rbe2f.F.

474C-----------------------------------------------
475C I m p l i c i t T y p e s
476C-----------------------------------------------
477#include "implicit_f.inc"
478C-----------------------------------------------
479C C o m m o n B l o c k s
480C-----------------------------------------------
481#include "com04_c.inc"
482#include "param_c.inc"
483C-----------------------------------------------
484C D u m m y A r g u m e n t s
485C-----------------------------------------------
486 INTEGER IRBE2(NRBE2L,*),WEIGHT(*),NMRBE2,JR(3,*),IH
487C REAL
488 my_real
489 . a(3,*), ar(3,*), ms(*), in(*) ,stifn(*) ,stifr(*)
490 double precision
491 . f6(3,6,*), m6(3,6,*) ,st6(6,*) ,sr6(6,*)
492C-----------------------------------------------
493C L o c a l V a r i a b l e s
494C-----------------------------------------------
495 INTEGER I, K, N, NS ,NML, IAD,JJ,M,MID,IROT,IRAD
496C REAL
497C======================================================================|
498#include "vectorize.inc"
499 DO n=1,nrbe2
500 IF (ih/=irbe2(9,n)) cycle
501 m = irbe2(3,n)
502 mid = irbe2(6,n)
503 irad = irbe2(11,n)
504 IF (mid<0) cycle
505 irot = jr(1,n)+jr(2,n)+jr(3,n)
506 DO k=1,6
507 a(1,m) = a(1,m)+ f6(1,k,mid)
508 a(2,m) = a(2,m)+ f6(2,k,mid)
509 a(3,m) = a(3,m)+ f6(3,k,mid)
510 stifn(m) = stifn(m)+st6(k,mid)
511 ENDDO
512 IF (irot>0.OR.irad==0) THEN
513 DO k=1,6
514 ar(1,m) = ar(1,m)+ m6(1,k,mid)
515 ar(2,m) = ar(2,m)+ m6(2,k,mid)
516 ar(3,m) = ar(3,m)+ m6(3,k,mid)
517 stifr(m) = stifr(m)+sr6(k,mid)
518 ENDDO
519 ENDIF
520 ENDDO
521C---
522 RETURN

◆ rbe2f()

subroutine rbe2f ( integer nsl,
integer, dimension(*) isl,
x,
a,
ar,
ms,
in,
integer, dimension(*) weight,
integer, dimension(3) jt,
integer, dimension(3) jr,
double precision, dimension(3,6) f6,
double precision, dimension(3,6) m6,
stifn,
stifr,
double precision, dimension(6) stif6,
double precision, dimension(6) stir6,
integer m,
integer irad )

Definition at line 131 of file rbe2f.F.

135C-----------------------------------------------
136C I m p l i c i t T y p e s
137C-----------------------------------------------
138#include "implicit_f.inc"
139C-----------------------------------------------
140C D u m m y A r g u m e n t s
141C-----------------------------------------------
142 INTEGER NSL,ISL(*),WEIGHT(*),JT(3),JR(3),M,IRAD
143C REAL
144 my_real
145 . x(3,*), a(3,*), ar(3,*), ms(*), in(*) ,stifn(*) ,stifr(*)
146 double precision
147 . f6(3,6), m6(3,6),stif6(6), stir6(6)
148C-----------------------------------------------
149C L o c a l V a r i a b l e s
150C-----------------------------------------------
151 INTEGER I, J, N, NS ,JTW(3),JRW(3),K,IJT,IJR
152C REAL
153 my_real
154 . rx, ry, rz,as(3,nsl),stis(nsl),dd,fx,fy,fz
155 double precision
156 . as6(6,3,nsl),stis6(6,nsl)
157C======================================================================|
158 IF ((jt(1)+jt(2)+jt(3))>0) THEN
159 ijt=1
160 ELSE
161 ijt=0
162 ENDIF
163 IF ((jr(1)+jr(2)+jr(3))>0) THEN
164 ijr=1
165 ELSE
166 ijr=0
167 ENDIF
168 DO i=1,nsl
169 ns = isl(i)
170 DO j=1,3
171 jtw(j) = jt(j)*weight(ns)
172 as(j,i) = a(j,ns)*jtw(j)
173 ENDDO
174 stis(i) = stifn(ns)*ijt*weight(ns)
175 ENDDO
176 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
177 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
178c--- summ secnd forces pon
179 DO i=1,nsl
180 DO k=1,6
181 f6(1,k) = f6(1,k) + as6(k,1,i)
182 f6(2,k) = f6(2,k) + as6(k,2,i)
183 f6(3,k) = f6(3,k) + as6(k,3,i)
184 stif6(k) = stif6(k) + stis6(k,i)
185 ENDDO
186 ENDDO
187C-----------Nastran's formulation----
188 IF (irad==0) THEN
189 DO i=1,nsl
190 ns = isl(i)
191 DO j=1,3
192 jrw(j) = jr(j)*weight(ns)
193 jtw(j) = jt(j)*weight(ns)
194 ENDDO
195 rx = x(1,ns) - x(1,m)
196 ry = x(2,ns) - x(2,m)
197 rz = x(3,ns) - x(3,m)
198 fx = a(1,ns) *jtw(1)
199 fy = a(2,ns) *jtw(2)
200 fz = a(3,ns) *jtw(3)
201 as(1,i) = ar(1,ns)*jrw(1)+ ry*fz-rz*fy
202 as(2,i) = ar(2,ns)*jrw(2)+ rz*fx-rx*fz
203 as(3,i) = ar(3,ns)*jrw(3)+ rx*fy-ry*fx
204 dd = rx*rx+ry*ry+rz*rz
205 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd*ijt)*weight(ns)
206 ENDDO
207 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
208 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
209c--- summ secnd moments pon
210 DO i=1,nsl
211 DO k=1,6
212 m6(1,k) = m6(1,k)+as6(k,1,i)
213 m6(2,k) = m6(2,k)+as6(k,2,i)
214 m6(3,k) = m6(3,k)+as6(k,3,i)
215 stir6(k) = stir6(k) + stis6(k,i)
216 ENDDO
217 ENDDO
218 ELSEIF ((jr(1)+jr(2)+jr(3))>0) THEN
219 DO i=1,nsl
220 ns = isl(i)
221 DO j=1,3
222 jrw(j) = jr(j)*weight(ns)
223 ENDDO
224 rx = x(1,ns) - x(1,m)
225 ry = x(2,ns) - x(2,m)
226 rz = x(3,ns) - x(3,m)
227 as(1,i) = (ar(1,ns)+(ry*a(3,ns)-rz*a(2,ns)))*jrw(1)
228 as(2,i) = (ar(2,ns)+(rz*a(1,ns)-rx*a(3,ns)))*jrw(2)
229 as(3,i) = (ar(3,ns)+(rx*a(2,ns)-ry*a(1,ns)))*jrw(3)
230 dd = rx*rx+ry*ry+rz*rz
231 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd*ijt)*weight(ns)
232 ENDDO
233 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
234 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
235c--- summ secnd moments pon
236 DO i=1,nsl
237 DO k=1,6
238 m6(1,k) = m6(1,k)+as6(k,1,i)
239 m6(2,k) = m6(2,k)+as6(k,2,i)
240 m6(3,k) = m6(3,k)+as6(k,3,i)
241 stir6(k) = stir6(k) + stis6(k,i)
242 ENDDO
243 ENDDO
244 END IF
245C--- reset of secnd nodes forces is necessary w/AMS
246 IF(ijt/=0)THEN
247 DO i=1,nsl
248 ns = isl(i)
249 DO j=1,3
250 IF(jt(j)/=0)a(j,ns)=zero
251 ENDDO
252C--- partial depending dof will add more mass w/ /DT/NODA w.r.t. RBODY
253 IF ((jt(1)+jt(2)+jt(3))==3)stifn(ns)=em20
254 ENDDO
255 END IF
256 IF(ijr/=0)THEN
257 DO i=1,nsl
258 ns = isl(i)
259 DO j=1,3
260 IF(jr(j)/=0)ar(j,ns)=zero
261 ENDDO
262 IF ((jr(1)+jr(2)+jr(3))==3) stifr(ns)=em20
263 ENDDO
264 END IF
265C---
266 RETURN
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225

◆ rbe2fl()

subroutine rbe2fl ( integer nsl,
integer, dimension(*) isl,
x,
a,
ar,
ms,
in,
integer, dimension(*) weight,
integer, dimension(3) jt,
integer, dimension(3) jr,
double precision, dimension(3,6) f6,
double precision, dimension(3,6) m6,
stifn,
stifr,
double precision, dimension(6) stif6,
double precision, dimension(6) stir6,
integer m,
skew,
integer irad )

Definition at line 278 of file rbe2f.F.

282C-----------------------------------------------
283C I m p l i c i t T y p e s
284C-----------------------------------------------
285#include "implicit_f.inc"
286C-----------------------------------------------
287C D u m m y A r g u m e n t s
288C-----------------------------------------------
289 INTEGER NSL,ISL(*),WEIGHT(*),JT(3),JR(3),M,IRAD
290C REAL
291 my_real
292 . x(3,*), a(3,*), ar(3,*), ms(*),in(*),skew(*),stifn(*),stifr(*)
293 double precision
294 . f6(3,6), m6(3,6),stif6(6), stir6(6)
295C-----------------------------------------------
296C L o c a l V a r i a b l e s
297C-----------------------------------------------
298 INTEGER I, J, NS ,K,IC,JT1(3),JR1(3),IJT,IJR,JJ
299C REAL
300 my_real
301 . rx, ry, rz,as(3,nsl),aar(3),larm(3),las(3,nsl),
302 . stis(nsl),dd,cdt(9),cdr(9),cdtr(9),aa
303 double precision
304 . as6(6,3,nsl),stis6(6,nsl)
305C======================================================================|
306 ic = jt(1)*100+jt(2)*10+jt(3)
307 CALL cdi_bcn(ic ,skew ,jt ,cdt ,jt1 )
308 IF ((jt(1)+jt(2)+jt(3))>0) THEN
309 ijt=1
310 ELSE
311 ijt=0
312 ENDIF
313 IF ((jr(1)+jr(2)+jr(3))>0) THEN
314 ijr=1
315 ELSE
316 ijr=0
317 ENDIF
318 DO i=1,nsl
319 ns = isl(i)
320 rx = a(1,ns)*weight(ns)
321 ry = a(2,ns)*weight(ns)
322 rz = a(3,ns)*weight(ns)
323 as(1,i) = cdt(1)*rx+cdt(2)*ry+cdt(3)*rz
324 as(2,i) = cdt(4)*rx+cdt(5)*ry+cdt(6)*rz
325 as(3,i) = cdt(7)*rx+cdt(8)*ry+cdt(9)*rz
326 las(1,i) = rx
327 las(2,i) = ry
328 las(3,i) = rz
329 stis(i) = stifn(ns)*ijt*weight(ns)
330 ENDDO
331 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
332 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
333c--- summ secnd forces pon
334 DO i=1,nsl
335 DO k=1,6
336 f6(1,k) = f6(1,k) + as6(k,1,i)
337 f6(2,k) = f6(2,k) + as6(k,2,i)
338 f6(3,k) = f6(3,k) + as6(k,3,i)
339 stif6(k) = stif6(k) + stis6(k,i)
340 ENDDO
341 ENDDO
342C--- NS components
343 IF (ic>0.AND.ic<111) THEN
344 CALL rbe2flsn(nsl ,isl ,a ,weight ,ic ,
345 1 skew )
346 END IF
347C---
348 IF (irad==0.OR.(jr(1)+jr(2)+jr(3))>0) THEN
349 ic = jr(1)*100+jr(2)*10+jr(3)
350 CALL cdi_bcn(ic ,skew ,jr ,cdr ,jr1 )
351 DO i=1,nsl
352 ns = isl(i)
353 rx = x(1,ns) - x(1,m)
354 ry = x(2,ns) - x(2,m)
355 rz = x(3,ns) - x(3,m)
356 CALL cdi_bcn1(rx,ry,rz,jt,jr,skew,cdtr,irad)
357 dd = rx*rx+ry*ry+rz*rz
358C
359 aar(1) = cdtr(1)*las(1,i)+cdtr(2)*las(2,i)+cdtr(3)*las(3,i)
360 aar(2) = cdtr(4)*las(1,i)+cdtr(5)*las(2,i)+cdtr(6)*las(3,i)
361 aar(3) = cdtr(7)*las(1,i)+cdtr(8)*las(2,i)+cdtr(9)*las(3,i)
362 rx = ar(1,ns)*weight(ns)
363 ry = ar(2,ns)*weight(ns)
364 rz = ar(3,ns)*weight(ns)
365 as(1,i)= aar(1)+cdr(1)*rx+cdr(2)*ry+cdr(3)*rz
366 as(2,i)= aar(2)+cdr(4)*rx+cdr(5)*ry+cdr(6)*rz
367 as(3,i)= aar(3)+cdr(7)*rx+cdr(8)*ry+cdr(9)*rz
368 stis(i) = (stifr(ns)*ijr+stifn(ns)*dd)*weight(ns)
369 ENDDO
370 CALL foat_to_6_float(1 ,nsl*3 ,as ,as6 )
371 CALL foat_to_6_float(1 ,nsl ,stis ,stis6 )
372c--- summ secnd moments pon
373 DO i=1,nsl
374 DO k=1,6
375 m6(1,k) = m6(1,k)+as6(k,1,i)
376 m6(2,k) = m6(2,k)+as6(k,2,i)
377 m6(3,k) = m6(3,k)+as6(k,3,i)
378 stir6(k) = stir6(k) + stis6(k,i)
379 ENDDO
380 ENDDO
381 IF (ic>0.AND.ic<111) THEN
382 CALL rbe2flsn(nsl ,isl ,ar ,weight ,ic ,
383 1 skew )
384 END IF
385 END IF
386C--- reset of secnd nodes forces is necessary w/AMS
387 IF(ijt/=0)THEN
388 DO i=1,nsl
389 ns = isl(i)
390 DO j=1,3
391 IF(jt(j)/=0)THEN
392 jj=3*(j-1)
393 aa=a(1,ns)*cdt(jj+1)+a(2,ns)*cdt(jj+2)+a(3,ns)*cdt(jj+3)
394 a(1,ns)=a(1,ns)-aa*cdt(jj+1)
395 a(2,ns)=a(2,ns)-aa*cdt(jj+2)
396 a(3,ns)=a(3,ns)-aa*cdt(jj+3)
397 END IF
398 ENDDO
399 IF ((jt(1)+jt(2)+jt(3))==3)stifn(ns)=em20
400 ENDDO
401 END IF
402 IF(ijr/=0)THEN
403 DO i=1,nsl
404 ns = isl(i)
405 DO j=1,3
406 IF(jr(j)/=0)THEN
407 jj=3*(j-1)
408 aa=ar(1,ns)*cdr(jj+1)+ar(2,ns)*cdr(jj+2)+ar(3,ns)*cdr(jj+3)
409 ar(1,ns)=ar(1,ns)-aa*cdr(jj+1)
410 ar(2,ns)=ar(2,ns)-aa*cdr(jj+2)
411 ar(3,ns)=ar(3,ns)-aa*cdr(jj+3)
412 END IF
413 ENDDO
414 IF ((jr(1)+jr(2)+jr(3))==3) stifr(ns)=em20
415 ENDDO
416 END IF
417C---
418 RETURN
cdi_bcn1
subroutine cdi_bcn1(xs, ys, zs, jt, jr, skew, ktr, irad)
Definition rbe2_imp0.F:1449
cdi_bcn
subroutine cdi_bcn(ict, skew, jt, kt, jt1)
Definition rbe2_imp0.F:1012
rbe2flsn
subroutine rbe2flsn(nsl, isl, a, weight, ict, skew)
Definition rbe2f.F:785

◆ rbe2flsn()

subroutine rbe2flsn ( integer nsl,
integer, dimension(*) isl,
a,
integer, dimension(*) weight,
integer ict,
skew )

Definition at line 783 of file rbe2f.F.

785C-----------------------------------------------
786C I m p l i c i t T y p e s
787C-----------------------------------------------
788#include "implicit_f.inc"
789C-----------------------------------------------
790C D u m m y A r g u m e n t s
791C-----------------------------------------------
792 INTEGER NSL ,ISL(*) ,ICT, WEIGHT(*)
793 my_real
794 . skew(*),a(3,*)
795C-----------------------------------------------
796C L o c a l V a r i a b l e s
797C-----------------------------------------------
798 INTEGER I,J,K,J1,L,NS
799 my_real
800 . ej(3),ej1(3),s,ea,eb
801C----------------100-------------------------
802 SELECT CASE (ict)
803 CASE(100)
804 ej(1)=skew(1)
805 ej(2)=skew(2)
806 ej(3)=skew(3)
807 CALL l_dir(ej,j)
808 j1=0
809 CALL dir_rbe2(j ,j1 ,k )
810C----------------010-------------------------
811 CASE(10)
812 ej(1)=skew(4)
813 ej(2)=skew(5)
814 ej(3)=skew(6)
815 CALL l_dir(ej,j)
816 j1=0
817 CALL dir_rbe2(j ,j1 ,k )
818C----------------001-------------------------
819 CASE(1)
820 ej(1)=skew(7)
821 ej(2)=skew(8)
822 ej(3)=skew(9)
823 CALL l_dir(ej,j)
824 j1=0
825 CALL dir_rbe2(j ,j1 ,k )
826C----------------011-------------------------
827 CASE(11)
828 ej(1)=skew(7)
829 ej(2)=skew(8)
830 ej(3)=skew(9)
831 CALL l_dir(ej,j)
832 ej1(1)=skew(4)
833 ej1(2)=skew(5)
834 ej1(3)=skew(6)
835 CALL l_dir(ej1,j1)
836 IF (j1==j) THEN
837 ej1(j)=zero
838 CALL l_dir(ej1,j1)
839 ej1(1)=skew(4)/skew(3+j1)
840 ej1(2)=skew(5)/skew(3+j1)
841 ej1(3)=skew(6)/skew(3+j1)
842 ENDIF
843 CALL dir_rbe2(j ,j1 ,k )
844 s=one/(one-ej(j1)*ej1(j))
845 ea=s*(ej(j1)*ej1(k)-ej(k))
846 eb=s*(ej1(j)*ej(k)-ej1(k))
847C----------------101-------------------------
848 CASE(101)
849 ej(1)=skew(7)
850 ej(2)=skew(8)
851 ej(3)=skew(9)
852 CALL l_dir(ej,j)
853 ej1(1)=skew(1)
854 ej1(2)=skew(2)
855 ej1(3)=skew(3)
856 CALL l_dir(ej1,j1)
857 IF (j1==j) THEN
858 ej1(j)=zero
859 CALL l_dir(ej1,j1)
860 ej1(1)=skew(1)/skew(j1)
861 ej1(2)=skew(2)/skew(j1)
862 ej1(3)=skew(3)/skew(j1)
863 ENDIF
864 CALL dir_rbe2(j ,j1 ,k )
865 s=one/(one-ej(j1)*ej1(j))
866 ea=s*(ej(j1)*ej1(k)-ej(k))
867 eb=s*(ej1(j)*ej(k)-ej1(k))
868C----------------110-------------------------
869 CASE(110)
870 ej(1)=skew(4)
871 ej(2)=skew(5)
872 ej(3)=skew(6)
873 CALL l_dir(ej,j)
874 ej1(1)=skew(1)
875 ej1(2)=skew(2)
876 ej1(3)=skew(3)
877 CALL l_dir(ej1,j1)
878 IF (j1==j) THEN
879 ej1(j)=zero
880 CALL l_dir(ej1,j1)
881 ej1(1)=skew(1)/skew(j1)
882 ej1(2)=skew(2)/skew(j1)
883 ej1(3)=skew(3)/skew(j1)
884 ENDIF
885 CALL dir_rbe2(j ,j1 ,k )
886 s=one/(one-ej(j1)*ej1(j))
887 ea=s*(ej(j1)*ej1(k)-ej(k))
888 eb=s*(ej1(j)*ej(k)-ej1(k))
889 END SELECT
890C
891 DO i=1,nsl
892 ns = isl(i)
893 IF (weight(ns)==0) cycle
894C-------------------100---------------------
895 IF (ict == 100 ) THEN
896 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
897 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
898C-------------------010---------------------
899 ELSEIF (ict == 10) THEN
900 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
901 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
902C-------------------001---------------------
903 ELSEIF (ict == 1) THEN
904 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
905 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
906C-------------------011---------------------
907 ELSEIF (ict == 11) THEN
908 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
909C-------------------101---------------------
910 ELSEIF (ict == 101) THEN
911 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
912C-------------------110---------------------
913 ELSEIF (ict == 110 ) THEN
914 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
915 ENDIF
916 ENDDO
917C
918 RETURN
l_dir
subroutine l_dir(ej, j)
Definition bc_imp0.F:405
dir_rbe2
subroutine dir_rbe2(j, j1, k)
Definition rbe2v.F:714

◆ rbe2flsnfr()

subroutine rbe2flsnfr ( integer ns,
a,
integer ict,
skew )

Definition at line 928 of file rbe2f.F.

929C-----------------------------------------------
930C I m p l i c i t T y p e s
931C-----------------------------------------------
932#include "implicit_f.inc"
933C-----------------------------------------------
934C D u m m y A r g u m e n t s
935C-----------------------------------------------
936 INTEGER NS ,ICT
937 my_real
938 . skew(*),a(3,*)
939C-----------------------------------------------
940C L o c a l V a r i a b l e s
941C-----------------------------------------------
942 INTEGER I,J,K,J1,L
943 my_real
944 . ej(3),ej1(3),s,ea,eb
945C----------------100-------------------------
946 SELECT CASE (ict)
947 CASE(100)
948 ej(1)=skew(1)
949 ej(2)=skew(2)
950 ej(3)=skew(3)
951 CALL l_dir(ej,j)
952 j1=0
953 CALL dir_rbe2(j ,j1 ,k )
954 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
955 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
956C----------------010-------------------------
957 CASE(10)
958 ej(1)=skew(4)
959 ej(2)=skew(5)
960 ej(3)=skew(6)
961 CALL l_dir(ej,j)
962 j1=0
963 CALL dir_rbe2(j ,j1 ,k )
964 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
965 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
966C----------------001-------------------------
967 CASE(1)
968 ej(1)=skew(7)
969 ej(2)=skew(8)
970 ej(3)=skew(9)
971 CALL l_dir(ej,j)
972 j1=0
973 CALL dir_rbe2(j ,j1 ,k )
974 a(j1,ns) = a(j1,ns)-ej(j1)*a(j,ns)
975 a(k,ns) = a(k,ns)-ej(k)*a(j,ns)
976C----------------011-------------------------
977 CASE(11)
978 ej(1)=skew(7)
979 ej(2)=skew(8)
980 ej(3)=skew(9)
981 CALL l_dir(ej,j)
982 ej1(1)=skew(4)
983 ej1(2)=skew(5)
984 ej1(3)=skew(6)
985 CALL l_dir(ej1,j1)
986 IF (j1==j) THEN
987 ej1(j)=zero
988 CALL l_dir(ej1,j1)
989 ej1(1)=skew(4)/skew(3+j1)
990 ej1(2)=skew(5)/skew(3+j1)
991 ej1(3)=skew(6)/skew(3+j1)
992 ENDIF
993 CALL dir_rbe2(j ,j1 ,k )
994 s=one/(one-ej(j1)*ej1(j))
995 ea=s*(ej(j1)*ej1(k)-ej(k))
996 eb=s*(ej1(j)*ej(k)-ej1(k))
997 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
998C----------------101-------------------------
999 CASE(101)
1000 ej(1)=skew(7)
1001 ej(2)=skew(8)
1002 ej(3)=skew(9)
1003 CALL l_dir(ej,j)
1004 ej1(1)=skew(1)
1005 ej1(2)=skew(2)
1006 ej1(3)=skew(3)
1007 CALL l_dir(ej1,j1)
1008 IF (j1==j) THEN
1009 ej1(j)=zero
1010 CALL l_dir(ej1,j1)
1011 ej1(1)=skew(1)/skew(j1)
1012 ej1(2)=skew(2)/skew(j1)
1013 ej1(3)=skew(3)/skew(j1)
1014 ENDIF
1015 CALL dir_rbe2(j ,j1 ,k )
1016 s=one/(one-ej(j1)*ej1(j))
1017 ea=s*(ej(j1)*ej1(k)-ej(k))
1018 eb=s*(ej1(j)*ej(k)-ej1(k))
1019 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
1020C----------------110-------------------------
1021 CASE(110)
1022 ej(1)=skew(4)
1023 ej(2)=skew(5)
1024 ej(3)=skew(6)
1025 CALL l_dir(ej,j)
1026 ej1(1)=skew(1)
1027 ej1(2)=skew(2)
1028 ej1(3)=skew(3)
1029 CALL l_dir(ej1,j1)
1030 IF (j1==j) THEN
1031 ej1(j)=zero
1032 CALL l_dir(ej1,j1)
1033 ej1(1)=skew(1)/skew(j1)
1034 ej1(2)=skew(2)/skew(j1)
1035 ej1(3)=skew(3)/skew(j1)
1036 ENDIF
1037 CALL dir_rbe2(j ,j1 ,k )
1038 s=one/(one-ej(j1)*ej1(j))
1039 ea=s*(ej(j1)*ej1(k)-ej(k))
1040 eb=s*(ej1(j)*ej(k)-ej1(k))
1041 a(k,ns)=a(k,ns)+ea*a(j,ns)+eb*a(j1,ns)
1042 END SELECT
1043C
1044 RETURN

◆ rbe2frf()

subroutine rbe2frf ( integer ns,
integer m,
a,
ar,
integer, dimension(*) jt,
integer, dimension(*) jr,
x,
integer isk,
skew0,
integer irad )

Definition at line 704 of file rbe2f.F.

706C-----------------------------------------------
707C I m p l i c i t T y p e s
708C-----------------------------------------------
709#include "implicit_f.inc"
710C-----------------------------------------------
711C C o m m o n B l o c k s
712C-----------------------------------------------
713#include "param_c.inc"
714C-----------------------------------------------
715C D u m m y A r g u m e n t s
716C-----------------------------------------------
717 INTEGER NS , M,JT(*),JR(*),ISK,IRAD
718C REAL
719 my_real
720 . a(3,*), ar(3,*), skew0(*),x(3,*)
721C-----------------------------------------------
722C L o c a l V a r i a b l e s
723C-----------------------------------------------
724 INTEGER I, J, N,K,JT1(3),JR1(3),IC
725C REAL
726 my_real
727 . rx,ry,rz,fx,fy,fz, skew(lskew),cdt(9),cdr(9),cdtr(9),aar(3)
728C======================================================================|
729 IF (isk>1) THEN
730 DO k=1,9
731 skew(k)=skew0(k)
732 ENDDO
733 ELSE
734 DO k=1,lskew
735 skew(k)=zero
736 ENDDO
737 skew(1)=one
738 skew(5)=one
739 skew(9)=one
740 ENDIF
741 ic = jt(1)*100+jt(2)*10+jt(3)
742 CALL cdi_bcn(ic ,skew ,jt ,cdt ,jt1 )
743 a(1,m) = a(1,m)+cdt(1)*a(1,ns)+cdt(2)*a(2,ns)+cdt(3)*a(3,ns)
744 a(2,m) = a(2,m)+cdt(4)*a(1,ns)+cdt(5)*a(2,ns)+cdt(6)*a(3,ns)
745 a(3,m) = a(3,m)+cdt(7)*a(1,ns)+cdt(8)*a(2,ns)+cdt(9)*a(3,ns)
746C--- NS components
747 IF (ic>0.AND.ic<111) THEN
748 CALL rbe2flsnfr(ns ,a ,ic ,skew )
749 END IF
750C---
751 IF (irad==0.OR.(jr(1)+jr(2)+jr(3))>0) THEN
752 ic = jr(1)*100+jr(2)*10+jr(3)
753 CALL cdi_bcn(ic ,skew ,jr ,cdr ,jr1 )
754 rx = x(1,ns) - x(1,m)
755 ry = x(2,ns) - x(2,m)
756 rz = x(3,ns) - x(3,m)
757 CALL cdi_bcn1(rx,ry,rz,jt,jr,skew,cdtr,irad)
758C
759 aar(1) = cdtr(1)*a(1,ns)+cdtr(2)*a(2,ns)+cdtr(3)*a(3,ns)
760 aar(2) = cdtr(4)*a(1,ns)+cdtr(5)*a(2,ns)+cdtr(6)*a(3,ns)
761 aar(3) = cdtr(7)*a(1,ns)+cdtr(8)*a(2,ns)+cdtr(9)*a(3,ns)
762 ar(1,m)= ar(1,m)+
763 . aar(1)+cdr(1)*ar(1,ns)+cdr(2)*ar(2,ns)+cdr(3)*ar(3,ns)
764 ar(2,m)= ar(2,m)+
765 . aar(2)+cdr(4)*ar(1,ns)+cdr(5)*ar(2,ns)+cdr(6)*ar(3,ns)
766 ar(3,m)= ar(3,m)+
767 . aar(3)+cdr(7)*ar(1,ns)+cdr(8)*ar(2,ns)+cdr(9)*ar(3,ns)
768 IF (ic>0.AND.ic<111) THEN
769 CALL rbe2flsnfr(ns ,ar ,ic ,skew )
770 END IF
771 END IF
772C---
773 RETURN
rbe2flsnfr
subroutine rbe2flsnfr(ns, a, ict, skew)
Definition rbe2f.F:929

◆ rbe2t1()

subroutine rbe2t1 ( integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
x,
a,
ar,
ms,
in,
skew,
integer, dimension(*) weight,
integer, dimension(*) iad_rbe2,
integer, dimension(*) fr_rbe2m,
integer nmrbe2,
stifn,
stifr,
integer r2size )

Definition at line 35 of file rbe2f.F.

38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IRBE2(NRBE2L,*),LRBE2(*),WEIGHT(*),IAD_RBE2(*),
52 . FR_RBE2M(*) ,NMRBE2,R2SIZE
53C REAL
54 my_real
55 . stifn(*) ,stifr(*),x(3,*), a(3,*), ar(3,*),
56 . ms(*), in(*), skew(lskew,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, J, N, JT(3,NRBE2),JR(3,NRBE2),IERR,IAD,
61 . NS,NML,ICOM,ISK,M,K,ID,NSN,MID,IROT,NHI,IRAD
62C REAL
63 double precision
64 . frbe2m6(3,6,nmrbe2),mrbe2m6(3,6,nmrbe2),
65 . strbe2m6(6,nmrbe2),srrbe2m6(6,nmrbe2)
66C======================================================================|
67 CALL prerbe2(irbe2 ,jt ,jr )
68 icom = iad_rbe2(nspmd+1)-iad_rbe2(1)
69 IF (nspmd>1)CALL spmd_max_i(icom)
70 DO nhi=0,nhrbe2
71 DO n=1,nmrbe2
72 DO j=1,3
73 DO k=1,6
74 frbe2m6(j,k,n) = zero
75 mrbe2m6(j,k,n) = zero
76 END DO
77 END DO
78 DO k=1,6
79 strbe2m6(k,n) = zero
80 srrbe2m6(k,n) = zero
81 END DO
82 END DO
83c CALL RBE2_POFF(IRBE2 ,A ,AR ,MS ,IN ,
84c 1 STIFN ,STIFR ,WEIGHT,JR ,NHI )
85 DO n=1,nrbe2
86 IF (irbe2(9,n)/=nhi) cycle
87 iad = irbe2(1,n)
88 nsn = irbe2(5,n)
89 m = irbe2(3,n)
90 isk = irbe2(7,n)
91 mid = iabs(irbe2(6,n))
92 irad = irbe2(11,n)
93c print *,'iad,m,mid,ih=',iad,m,IRBE2(6,N),IRBE2(9,N)
94 IF (isk>1) THEN
95 CALL rbe2fl(nsn ,lrbe2(iad+1),x ,a ,ar ,
96 1 ms ,in ,weight,jt(1,n),jr(1,n),
97 2 frbe2m6(1,1,mid),mrbe2m6(1,1,mid),stifn ,stifr,
98 3 strbe2m6(1,mid),srrbe2m6(1,mid),m ,skew(1,isk),
99 4 irad )
100 ELSE
101 CALL rbe2f(nsn ,lrbe2(iad+1),x ,a ,ar ,
102 1 ms ,in ,weight,jt(1,n),jr(1,n),
103 2 frbe2m6(1,1,mid),mrbe2m6(1,1,mid),stifn ,stifr,
104 3 strbe2m6(1,mid),srrbe2m6(1,mid),m ,irad )
105 END IF
106 END DO
107C-----------------
108 IF (icom>0) THEN
109 CALL spmd_exch_rbe2_pon(
110 . frbe2m6 ,mrbe2m6 ,strbe2m6 ,srrbe2m6 ,iad_rbe2,
111 . fr_rbe2m,iad_rbe2(nspmd+1),r2size)
112 ENDIF
113C
114C Routine assemblage parith/ON
115C
116 CALL rbe2_s(irbe2 ,a ,ar ,ms ,in ,
117 1 stifn ,stifr ,weight ,frbe2m6,mrbe2m6,
118 2 strbe2m6,srrbe2m6,jr ,nmrbe2 ,nhi )
119C
120 END DO ! NHI=1,NHRBE2
121C---
122 RETURN
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
rbe2_s
subroutine rbe2_s(irbe2, a, ar, ms, in, stifn, stifr, weight, f6, m6, st6, sr6, jr, nmrbe2, ih)
Definition rbe2f.F:474
prerbe2
subroutine prerbe2(irbe2, jt, jr)
Definition rbe2f.F:542
rbe2fl
subroutine rbe2fl(nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, skew, irad)
Definition rbe2f.F:282
rbe2f
subroutine rbe2f(nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, irad)
Definition rbe2f.F:135
spmd_exch_rbe2_pon
subroutine spmd_exch_rbe2_pon(a, ar, stifn, stifr, iad_m, fr_m, lcomm, isize)
Definition spmd_exch_rbe2_pon.F:34