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

Go to the source code of this file.

Functions/Subroutines

subroutine rbe3_imp0 (irbe3, lrbe3, frbe3, x, skew, iss3, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, weight, itab)
subroutine rbe3_impi (irbe3, lrbe3, frbe3, x, skew, nss3, iss3, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, weight, itab)
subroutine rbe3_imp1 (ns, nml, iml, x, irot, nsj, isj, jt, jr, fdstnb, mdstnb, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, itab)
subroutine rbe3_impr1 (irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight)
subroutine rbe3_impb0 (ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b)
subroutine rbe3_impr2 (irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight, a, ar)
subroutine rbe3_impb2 (ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b, a, ar)
subroutine updk_bc (jt, jr, k, istif)
subroutine updk_bc2 (jt, jr, k, istif)
subroutine updb_cdi (fdi, mdi, bd, bi, irot)
subroutine updk_cdii (fdi, mdi, kdd, kii, irot, nd)
subroutine updk_cdij (fdi, mdi, fdj, mdj, kdd, kij, irot, nd)
subroutine updk_cdi (fdi, mdi, kdd, kij, irot, nd, isym)
subroutine updfrk_bc (jt, k, istif)
subroutine rbe3_frupd (nir, iml, fdstnb, mdstnb, ndof, jt, irot, kss, diag_m3)
subroutine rbe3_fr0 (ns, nml, iml, x, irot, jt, jr, frbe3, skew, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab, isk, id)
subroutine rbe3_fr1 (ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab)

Function/Subroutine Documentation

◆ rbe3_fr0()

subroutine rbe3_fr0 ( integer ns,
integer nml,
integer, dimension(*) iml,
x,
integer irot,
integer, dimension(3) jt,
integer, dimension(3) jr,
frbe3,
skew,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
kss,
ksm,
knm,
krm,
integer, dimension(*) idlm,
integer iss,
integer ism,
integer, dimension(*) itab,
integer, dimension(*) isk,
integer id )

Definition at line 1069 of file rbe3_imp0.F.

1074C-----------------------------------------------
1075C I m p l i c i t T y p e s
1076C-----------------------------------------------
1077#include "implicit_f.inc"
1078C-----------------------------------------------
1079C D u m m y A r g u m e n t s
1080C-----------------------------------------------
1081 INTEGER NS, NML,IML(*),JT(3),JR(3),IROT
1082 INTEGER IADK(*),JDIK(*),NDOF(*),ITAB(*),
1083 . IDLM(*) ,ISS ,ISM,ISK(*),IKC(*),ID
1084C REAL
1085 my_real
1086 . x(3,*),diag_k(*),lt_k(*),frbe3(*),skew(*),
1087 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
1088C-----------------------------------------------
1089C L o c a l V a r i a b l e s
1090C-----------------------------------------------
1091 INTEGER I, J
1092C REAL
1093 my_real
1094 . fdstnb(18,nml),mdstnb(18,nml)
1095C------------------------------------
1096C VITESSES DES NOEUDS SECONDS
1097C------------------------------------
1098 IF (ndof(ns)<=0) RETURN
1099 CALL rbe3cl(iml ,isk ,ns ,x ,frbe3 ,
1100 . skew ,nml ,irot ,fdstnb ,mdstnb ,id)
1101 CALL rbe3_fr1(ns ,nml ,iml ,x ,irot ,
1102 2 jt ,jr ,fdstnb ,mdstnb,ikc ,
1103 3 ndof ,iadk ,jdik ,diag_k ,lt_k ,
1104 2 kss ,ksm ,knm ,krm ,idlm ,
1105 3 iss ,ism ,itab )
1106C
1107 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
id
initmumps id
Definition multiplerhs_example.m:4
rbe3_fr1
subroutine rbe3_fr1(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ikc, ndof, iadk, jdik, diag_k, lt_k, kss, ksm, knm, krm, idlm, iss, ism, itab)
Definition rbe3_imp0.F:1126

◆ rbe3_fr1()

subroutine rbe3_fr1 ( integer ns,
integer nml,
integer, dimension(*) iml,
x,
integer irot,
integer, dimension(3) jt,
integer, dimension(3) jr,
fdstnb,
mdstnb,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
kss,
ksm,
knm,
krm,
integer, dimension(*) idlm,
integer iss,
integer ism,
integer, dimension(*) itab )

Definition at line 1121 of file rbe3_imp0.F.

1126C-----------------------------------------------
1127C I m p l i c i t T y p e s
1128C-----------------------------------------------
1129#include "implicit_f.inc"
1130C-----------------------------------------------
1131C D u m m y A r g u m e n t s
1132C-----------------------------------------------
1133 INTEGER NS, NML,IML(*),JT(3),JR(3),IROT
1134 INTEGER IADK(*),JDIK(*),NDOF(*),ITAB(*),
1135 . IDLM(*) ,ISS ,ISM,IKC(*)
1136 my_real
1137 . x(3,*),diag_k(*),lt_k(*),fdstnb(18,*),mdstnb(18,*),
1138 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
1139C-----------------------------------------------
1140C L o c a l V a r i a b l e s
1141C-----------------------------------------------
1142 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
1143 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
1144 . NIR1,IR,IP,ISTIF,NDOFI
1145 my_real
1146 . kdd(6,6),kii(6,6)
1147C------------------------------------
1148C VITESSES DES NOEUDS SECONDS
1149C------------------------------------
1150 IF (ndof(ns)<=0) RETURN
1151C
1152 ndofi = 3
1153 ip=4
1154 i = ns
1155 DO k=1,6
1156 DO j=1,6
1157 kdd(k,j)=zero
1158 ENDDO
1159 ENDDO
1160 IF (iss>0) THEN
1161 DO k=1,ndofi
1162 kdd(k,k) = kss(k)
1163 ENDDO
1164 kdd(1,2) = kss(4)
1165 kdd(1,3) = kss(5)
1166 kdd(2,3) = kss(6)
1167 kdd(2,1) = kdd(1,2)
1168 kdd(3,1) = kdd(1,3)
1169 kdd(3,2) = kdd(2,3)
1170C CALL UPDFRK_BC(JT,KDD,ISTIF)
1171C
1172C-------Update K(main node)---
1173C IF (ISTIF>0) THEN
1174 DO j=1,nml
1175 nj=iml(j)
1176 nd = ndof(nj)
1177C-------Update CDI^t[KDD]CDI---
1178 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndofi)
1179 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
1180 DO i1=j+1,nml
1181 nm=iml(i1)
1182C-------Update CDI^t[KDD]CDJ---
1183 CALL updk_cdij(fdstnb(1,j),mdstnb(1,j),fdstnb(1,i1),
1184 . mdstnb(1,i1),kdd,kii,irot,ndofi)
1185 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
1186 . kii,nd ,nd ,ir )
1187 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,ip )
1188 ENDDO
1189 ENDDO
1190 ELSE
1191 END IF
1192C END IF !(ISS>0) THEN
1193C--------no diag--Kjm=sum(KjsCsm)--
1194 IF (ism>0) THEN
1195C--------no diag--Kjm=sum(KjsCsm)--
1196 DO k=1,ndofi
1197 DO j=1,ndofi
1198 kdd(k,j) = ksm(k,j)
1199 ENDDO
1200 ENDDO
1201C------- Update ---
1202C CALL UPDFRK_BC(JT,KDD,ISTIF)
1203C IF (ISTIF>0) THEN
1204 DO j=1,nml
1205 nj=iml(j)
1206 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndofi,0)
1207 DO k=1,ndofi
1208 DO j1=1,ndofi
1209 knm(k,j1,j)=kii(j1,k)
1210 krm(k,j1,j)=kii(j1,k+ndofi)
1211 ENDDO
1212 ENDDO
1213 ENDDO
1214 ENDIF
1215C ENDIF
1216C
1217 RETURN
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:890
put_kmii
subroutine put_kmii(id, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:1186
put_kmij
subroutine put_kmij(ini, inj, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:1238
updk_cdij
subroutine updk_cdij(fdi, mdi, fdj, mdj, kdd, kij, irot, nd)
Definition rbe3_imp0.F:836
updk_cdii
subroutine updk_cdii(fdi, mdi, kdd, kii, irot, nd)
Definition rbe3_imp0.F:757
updk_cdi
subroutine updk_cdi(fdi, mdi, kdd, kij, irot, nd, isym)
Definition rbe3_imp0.F:910

◆ rbe3_frupd()

subroutine rbe3_frupd ( integer nir,
integer, dimension(*) iml,
fdstnb,
mdstnb,
integer, dimension(*) ndof,
integer, dimension(*) jt,
integer irot,
kss,
diag_m3 )

Definition at line 1015 of file rbe3_imp0.F.

1017C-----------------------------------------------
1018C I m p l i c i t T y p e s
1019C-----------------------------------------------
1020#include "implicit_f.inc"
1021C-----------------------------------------------
1022C D u m m y A r g u m e n t s
1023C-----------------------------------------------
1024 integer
1025 . nir ,iml(*) ,ndof(*),jt(*)
1026C REAL
1027 my_real
1028 . kss(6),diag_m3(6,nir),fdstnb(18,nir),mdstnb(18,nir)
1029C-----------------------------------------------
1030C L o c a l V a r i a b l e s
1031C-----------------------------------------------
1032 INTEGER I, J, JD, L, JJ,NJ,ND,IROT,NS,ISTIF
1033C REAL
1034 my_real
1035 . k0(6,6),kij(6,6)
1036C-----------------------------------------------
1037 nd = 3
1038 DO j = 1,3
1039 k0(j,j)=kss(j)
1040 ENDDO
1041 k0(1,2)=kss(4)
1042 k0(1,3)=kss(5)
1043 k0(2,3)=kss(6)
1044 k0(2,1) = k0(1,2)
1045 k0(3,1) = k0(1,3)
1046 k0(3,2) = k0(2,3)
1047 CALL updfrk_bc(jt,k0 ,istif)
1048 IF (istif>0) THEN
1049 DO j=1,nir
1050 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),
1051 . k0 ,kij ,irot ,nd )
1052 DO jj=1,6
1053 diag_m3(jj,j)=kij(jj,jj)
1054 ENDDO
1055 ENDDO
1056 ENDIF
1057C
1058 RETURN
updfrk_bc
subroutine updfrk_bc(jt, k, istif)
Definition rbe3_imp0.F:967

◆ rbe3_imp0()

subroutine rbe3_imp0 ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer, dimension(*) iss3,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
integer, dimension(*) weight,
integer, dimension(*) itab )

Definition at line 32 of file rbe3_imp0.F.

37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "param_c.inc"
46#include "tabsiz_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
51 . IADK(*),JDIK(*),NDOF(*),ITAB(*),
52 . IDDL(*),IKC(*),ISS3(*)
53C REAL
54 my_real
55 . x(3,*), skew(lskew,*), frbe3(*),
56 . diag_k(*),lt_k(*),b(*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
61 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ,IADJ
62C REAL
63 my_real,
64 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
65
66C-----------------------------------------------
67 iads = slrbe3/2
68 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
69 ALLOCATE(fdstnb(18*max_m))
70 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
71 iadj=1
72 DO n=1,nrbe3
73 iad = irbe3(1,n)
74 ns = irbe3(3,n)
75 nml = irbe3(5,n)
76 irot =irbe3(6,n)
77 nsj =irbe3(8,n)
78 IF (ns==0.OR.ndof(ns)==0) cycle
79 IF (weight(ns)/=0) THEN
80 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
81 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
82 . mdstnb ,irbe3(2,n))
83 CALL rbe3_imp1(ns ,nml ,lrbe3(iad+1) ,x ,irot ,
84 2 nsj ,iss3(iadj),jt(1,n) ,jr(1,n),fdstnb ,
85 3 mdstnb,ikc ,ndof ,iddl ,iadk ,
86 4 jdik ,diag_k,lt_k ,b ,itab )
87 END IF
88 iadj=iadj+nsj
89 ENDDO
90C
91 DEALLOCATE(fdstnb)
92 IF (irotg>0) DEALLOCATE(mdstnb)
93C
94 RETURN
prerbe3
subroutine prerbe3(irbe3, max_m, irotg, jt, jr)
Definition kinchk.F:1494
rbe3_imp1
subroutine rbe3_imp1(ns, nml, iml, x, irot, nsj, isj, jt, jr, fdstnb, mdstnb, ikc, ndof, iddl, iadk, jdik, diag_k, lt_k, b, itab)
Definition rbe3_imp0.F:191

◆ rbe3_imp1()

subroutine rbe3_imp1 ( integer ns,
integer nml,
integer, dimension(*) iml,
x,
integer irot,
integer nsj,
integer, dimension(*) isj,
integer, dimension(3) jt,
integer, dimension(3) jr,
fdstnb,
mdstnb,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
integer, dimension(*) itab )

Definition at line 187 of file rbe3_imp0.F.

191C-----------------------------------------------
192C I m p l i c i t T y p e s
193C-----------------------------------------------
194#include "implicit_f.inc"
195C-----------------------------------------------
196C D u m m y A r g u m e n t s
197C-----------------------------------------------
198 INTEGER NS, NML,IML(*),NSJ,ISJ(*) ,JT(3),JR(3),IROT
199 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*),ITAB(*)
200 my_real
201 . x(3,*),diag_k(*),lt_k(*),b(*),fdstnb(18,*),mdstnb(18,*)
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
206 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
207 . NIR1,IR,IP,ISTIF
208C REAL
209 my_real
210 . kdd(6,6),bd(6),kii(6,6),kij(6,6),bi(6)
211C------------------------------------
212C VITESSES DES NOEUDS SECONDS
213C------------------------------------
214 IF (ndof(ns)<=0) RETURN
215C
216 ip=4
217 i = ns
218 ndm = ndof(ns)
219 DO k=1,6
220 DO j=k,6
221 kdd(k,j)=zero
222 ENDDO
223 ENDDO
224 DO k=1,ndof(i)
225 id = iddl(i)+k
226 ikc(id)=13
227 bd(k)=b(id)
228 ENDDO
229 DO k=ndof(i)+1,6
230 bd(k)=zero
231 ENDDO
232 DO k=1,3
233 bd(k)=bd(k)*jt(k)
234 bd(k+3)=bd(k+3)*jr(k)
235 ENDDO
236 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
237 DO k=1,6
238 DO j=k,6
239 kdd(j,k)=kdd(k,j)
240 ENDDO
241 ENDDO
242C CALL UPDK_BC(JT,JR,KDD,ISTIF)
243C
244C-------Update K(main node)---
245C IF (ISTIF>0) THEN
246 DO j=1,nml
247 nj=iml(j)
248 nd = ndof(nj)
249C-------Update CDI^t[KDD]CDI---
250 CALL updk_cdii(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm)
251 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
252 DO i1=j+1,nml
253 nm=iml(i1)
254C-------Update CDI^t[KDD]CDJ---
255 CALL updk_cdij(fdstnb(1,j),mdstnb(1,j),fdstnb(1,i1),
256 . mdstnb(1,i1),kdd,kij,irot,ndm )
257 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kij,nd,ndof(nm),ir)
258 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,ip )
259 ENDDO
260 ENDDO
261C END IF
262 DO j=1,nml
263 nj=iml(j)
264 nd = ndof(nj)
265 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
266 DO k=1,nd
267 id = iddl(nj)+k
268 b(id) = b(id) + bi(k)
269 ENDDO
270 ENDDO
271C--------no diag--Kjm=sum(KjsCsm)--
272 DO i1 = 1,nsj
273 ni=isj(i1)
274 nidof=ndof(ni)
275 ndm = max(ndm,nidof)
276 DO k=1,6
277 DO j=1,6
278 kdd(k,j)=zero
279 ENDDO
280 ENDDO
281 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
282 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,ip )
283C------- Update ---
284C CALL UPDK_BC2(JT,JR,KDD,ISTIF)
285C IF (ISTIF>0) THEN
286 DO j=1,nml
287 nj=iml(j)
288 ndj = ndof(nj)
289 IF (ni==nj) THEN
290 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm,1)
291 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,ndj)
292 ELSE
293 CALL updk_cdi(fdstnb(1,j),mdstnb(1,j),kdd,kii,irot,ndm,0)
294 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,nidof,ndj,ir)
295 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,ip )
296 ENDIF
297 ENDDO
298C ENDIF
299 ENDDO
300C
301 RETURN
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:653
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:810
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:591
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713
max
#define max(a, b)
Definition macros.h:21
updb_cdi
subroutine updb_cdi(fdi, mdi, bd, bi, irot)
Definition rbe3_imp0.F:713

◆ rbe3_impb0()

subroutine rbe3_impb0 ( integer ns,
integer nml,
integer, dimension(*) iml,
x,
integer irot,
integer, dimension(3) jt,
integer, dimension(3) jr,
fdstnb,
mdstnb,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 378 of file rbe3_imp0.F.

381C-----------------------------------------------
382C I m p l i c i t T y p e s
383C-----------------------------------------------
384#include "implicit_f.inc"
385C-----------------------------------------------
386C D u m m y A r g u m e n t s
387C-----------------------------------------------
388 INTEGER NS, NML,IML(*),JT(3),JR(3),NDOF(*),IDDL(*),IROT
389 my_real
390 . x(3,*),b(*),fdstnb(18,*),mdstnb(18,*)
391C-----------------------------------------------
392C L o c a l V a r i a b l e s
393C-----------------------------------------------
394 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
395 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
396 . NIR1,IR,IP
397C REAL
398 my_real
399 . bd(6),bi(6)
400C------------------------------------
401C VITESSES DES NOEUDS SECONDS
402C------------------------------------
403 IF (ndof(ns)<=0) RETURN
404C
405 i = ns
406 DO k=1,ndof(i)
407 id = iddl(i)+k
408 bd(k)=b(id)
409 ENDDO
410 DO k=ndof(i)+1,6
411 bd(k)=zero
412 ENDDO
413 DO k=1,3
414 bd(k)=bd(k)*jt(k)
415 bd(k+3)=bd(k+3)*jr(k)
416 ENDDO
417C-------Update K(main node)---
418 DO j=1,nml
419 nj=iml(j)
420 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
421 DO k=1,ndof(nj)
422 id = iddl(nj)+k
423 b(id) = b(id) + bi(k)
424 ENDDO
425 ENDDO
426C
427 RETURN

◆ rbe3_impb2()

subroutine rbe3_impb2 ( integer ns,
integer nml,
integer, dimension(*) iml,
x,
integer irot,
integer, dimension(3) jt,
integer, dimension(3) jr,
fdstnb,
mdstnb,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
a,
ar )

Definition at line 505 of file rbe3_imp0.F.

508C-----------------------------------------------
509C I m p l i c i t T y p e s
510C-----------------------------------------------
511#include "implicit_f.inc"
512C-----------------------------------------------
513C D u m m y A r g u m e n t s
514C-----------------------------------------------
515 INTEGER NS, NML,IML(*),JT(3),JR(3),NDOF(*),IDDL(*),IROT
516C REAL
517 my_real
518 . x(3,*),b(*),fdstnb(18,*),mdstnb(18,*),a(3,*),ar(3,*)
519C-----------------------------------------------
520C C o m m o n B l o c k s
521C-----------------------------------------------
522#include "com01_c.inc"
523C-----------------------------------------------
524C L o c a l V a r i a b l e s
525C-----------------------------------------------
526 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
527 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
528 . NIR1,IR,IP
529C REAL
530 my_real
531 . bd(6),bi(6)
532C------------------------------------
533C VITESSES DES NOEUDS SECONDS
534C------------------------------------
535C
536 i = ns
537 IF (iroddl/=0) THEN
538 nd = 6
539 ELSE
540 nd = 3
541 ENDIF
542 IF (ndof(i)==0) THEN
543 DO k=1,3
544 bd(k)=a(k,i)
545 ENDDO
546 IF (nd==3) THEN
547 DO k=nd+1,6
548 bd(k)=zero
549 ENDDO
550 ELSE
551 DO k=1,3
552 bd(k+3)=ar(k,i)
553 ENDDO
554 ENDIF
555 DO k=1,3
556 bd(k)=bd(k)*jt(k)
557 bd(k+3)=bd(k+3)*jr(k)
558 ENDDO
559C-------Update K(main node)---
560 DO j=1,nml
561 nj=iml(j)
562 IF (ndof(nj)> 0) THEN
563 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
564 DO k=1,3
565 id = iddl(nj)+k
566 b(id)=bi(k)
567 ENDDO
568 IF (irot>0) THEN
569 DO k=4,6
570 id = iddl(nj)+k
571 b(id)=bi(k)
572 ENDDO
573 ENDIF
574 END IF
575 ENDDO
576C
577 ELSE
578 DO k=1,ndof(i)
579 id = iddl(i)+k
580 bd(k)=b(id)
581 ENDDO
582 DO k=ndof(i)+1,6
583 bd(k)=zero
584 ENDDO
585 ENDIF
586C
587 DO k=1,3
588 bd(k)=bd(k)*jt(k)
589 bd(k+3)=bd(k+3)*jr(k)
590 ENDDO
591C-------Update K(main node)---
592 DO j=1,nml
593 nj=iml(j)
594 IF (ndof(nj)==0) THEN
595 CALL updb_cdi(fdstnb(1,j),mdstnb(1,j),bd,bi,irot)
596 DO k=1,3
597 a(k,nj)=a(k,nj)+bi(k)
598 ENDDO
599 IF (irot>0) THEN
600 DO k=1,3
601 ar(k,nj)=ar(k,nj)+bi(k+3)
602 ENDDO
603 ENDIF
604 END IF
605 ENDDO
606C
607 RETURN

◆ rbe3_impi()

subroutine rbe3_impi ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer, dimension(*) nss3,
integer, dimension(*) iss3,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
integer, dimension(*) weight,
integer, dimension(*) itab )

Definition at line 105 of file rbe3_imp0.F.

110C-----------------------------------------------
111C I m p l i c i t T y p e s
112C-----------------------------------------------
113#include "implicit_f.inc"
114C-----------------------------------------------
115C C o m m o n B l o c k s
116C-----------------------------------------------
117#include "com04_c.inc"
118#include "param_c.inc"
119#include "tabsiz_c.inc"
120C-----------------------------------------------
121C D u m m y A r g u m e n t s
122C-----------------------------------------------
123 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
124 . IADK(*),JDIK(*),NDOF(*),ITAB(*),
125 . IDDL(*),IKC(*),NSS3(*),ISS3(*)
126C REAL
127 my_real
128 . x(3,*), skew(lskew,*), frbe3(*),
129 . diag_k(*),lt_k(*),b(*)
130C-----------------------------------------------
131C L o c a l V a r i a b l e s
132C-----------------------------------------------
133 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
134 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ,IADJ
135C REAL
136 my_real,
137 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
138
139C-----------------------------------------------
140 iads = slrbe3/2
141 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
142 ALLOCATE(fdstnb(18*max_m))
143 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
144 iadj=1
145 DO n=1,nrbe3
146 iad = irbe3(1,n)
147 ns = irbe3(3,n)
148 IF (ns==0) cycle
149 nml = irbe3(5,n)
150 irot =irbe3(6,n)
151 DO j =1,3
152 jr(j,n)=0
153 ENDDO
154 IF (weight(ns)/=0.AND.ndof(ns)>0) THEN
155 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
156 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
157 . mdstnb ,irbe3(2,n))
158 CALL rbe3_imp1(ns ,nml ,lrbe3(iad+1) ,x ,irot ,
159 2 nss3(n),iss3(iadj),jt(1,n) ,jr(1,n),fdstnb ,
160 3 mdstnb,ikc ,ndof ,iddl ,iadk ,
161 4 jdik ,diag_k,lt_k ,b ,itab )
162 iadj=iadj+nss3(n)
163 END IF
164 ENDDO
165C
166 DEALLOCATE(fdstnb)
167 IF (irotg>0) DEALLOCATE(mdstnb)
168C
169 RETURN

◆ rbe3_impr1()

subroutine rbe3_impr1 ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
integer, dimension(*) weight )

Definition at line 315 of file rbe3_imp0.F.

318C-----------------------------------------------
319C I m p l i c i t T y p e s
320C-----------------------------------------------
321#include "implicit_f.inc"
322C-----------------------------------------------
323C C o m m o n B l o c k s
324C-----------------------------------------------
325#include "com04_c.inc"
326#include "param_c.inc"
327#include "tabsiz_c.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
332 . NDOF(*),IDDL(*)
333C REAL
334 my_real
335 . x(3,*), skew(lskew,*), frbe3(*),b(*)
336C-----------------------------------------------
337C L o c a l V a r i a b l e s
338C-----------------------------------------------
339 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
340 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ
341C REAL
342 my_real,
343 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
344
345C-----------------------------------------------
346 iads = slrbe3/2
347 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
348 ALLOCATE(fdstnb(18*max_m))
349 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
350 DO n=1,nrbe3
351 iad = irbe3(1,n)
352 ns = irbe3(3,n)
353 IF (ns==0) cycle
354 nml = irbe3(5,n)
355 irot =irbe3(6,n)
356 IF (weight(ns)/=0) THEN
357 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
358 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
359 . mdstnb ,irbe3(2,n) )
360 CALL rbe3_impb0(ns ,nml ,lrbe3(iad+1),x ,irot ,
361 2 jt(1,n),jr(1,n),fdstnb ,mdstnb ,ndof ,
362 4 iddl ,b )
363 END IF
364 ENDDO
365C
366 DEALLOCATE(fdstnb)
367 IF (irotg>0) DEALLOCATE(mdstnb)
368C
369 RETURN
rbe3_impb0
subroutine rbe3_impb0(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b)
Definition rbe3_imp0.F:381

◆ rbe3_impr2()

subroutine rbe3_impr2 ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
integer, dimension(*) weight,
a,
ar )

Definition at line 441 of file rbe3_imp0.F.

445C-----------------------------------------------
446C I m p l i c i t T y p e s
447C-----------------------------------------------
448#include "implicit_f.inc"
449C-----------------------------------------------
450C C o m m o n B l o c k s
451C-----------------------------------------------
452#include "com04_c.inc"
453#include "param_c.inc"
454#include "tabsiz_c.inc"
455C-----------------------------------------------
456C D u m m y A r g u m e n t s
457C-----------------------------------------------
458 INTEGER WEIGHT(*),IRBE3(NRBE3L,*),LRBE3(*),
459 . NDOF(*),IDDL(*)
460C REAL
461 my_real
462 . x(3,*), skew(lskew,*), frbe3(*),b(*),a(*),ar(*)
463C-----------------------------------------------
464C L o c a l V a r i a b l e s
465C-----------------------------------------------
466 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
467 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,NSJ
468C REAL
469 my_real,
470 . DIMENSION(:),ALLOCATABLE :: fdstnb ,mdstnb
471
472C-----------------------------------------------
473 iads = slrbe3/2
474 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
475 ALLOCATE(fdstnb(18*max_m))
476 IF (irotg>0) ALLOCATE(mdstnb(18*max_m))
477 DO n=1,nrbe3
478 iad = irbe3(1,n)
479 ns = irbe3(3,n)
480 IF (ns==0) cycle
481 nml = irbe3(5,n)
482 irot =irbe3(6,n)
483 IF (weight(ns)/=0) THEN
484 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
485 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
486 . mdstnb ,irbe3(2,n))
487 CALL rbe3_impb2(ns ,nml ,lrbe3(iad+1),x ,irot ,
488 2 jt(1,n),jr(1,n),fdstnb ,mdstnb ,ndof ,
489 4 iddl ,b ,a ,ar )
490 END IF
491 ENDDO
492C
493 DEALLOCATE(fdstnb)
494 IF (irotg>0) DEALLOCATE(mdstnb)
495C
496 RETURN
rbe3_impb2
subroutine rbe3_impb2(ns, nml, iml, x, irot, jt, jr, fdstnb, mdstnb, ndof, iddl, b, a, ar)
Definition rbe3_imp0.F:508

◆ updb_cdi()

subroutine updb_cdi ( fdi,
mdi,
bd,
bi,
integer irot )

Definition at line 712 of file rbe3_imp0.F.

713C-----------------------------------------------
714C I m p l i c i t T y p e s
715C-----------------------------------------------
716#include "implicit_f.inc"
717C-----------------------------------------------
718C D u m m y A r g u m e n t s
719C-----------------------------------------------
720 INTEGER IROT
721C REAL
722 my_real
723 . fdi(3,6),mdi(3,6),bd(6),bi(6)
724C-----------------------------------------------
725C L o c a l V a r i a b l e s
726C-----------------------------------------------
727 INTEGER I, J
728C REAL
729C-------Update =CDI^t[BD]---
730 DO j=1,6
731 bi(j) = zero
732 ENDDO
733C
734 DO i=1,3
735 DO j=1,6
736 bi(i)=bi(i)+fdi(i,j)*bd(j)
737 ENDDO
738 ENDDO
739 IF (irot>0) THEN
740 DO i=4,6
741 DO j=1,6
742 bi(i)=bi(i)+mdi(i-3,j)*bd(j)
743 ENDDO
744 ENDDO
745 END IF
746C
747 RETURN

◆ updfrk_bc()

subroutine updfrk_bc ( integer, dimension(3) jt,
k,
integer istif )

Definition at line 966 of file rbe3_imp0.F.

967C-----------------------------------------------
968C I m p l i c i t T y p e s
969C-----------------------------------------------
970#include "implicit_f.inc"
971C-----------------------------------------------
972C D u m m y A r g u m e n t s
973C-----------------------------------------------
974 INTEGER JT(3),ISTIF
975C REAL
976 my_real
977 . k(6,6)
978C-----------------------------------------------
979C L o c a l V a r i a b l e s
980C-----------------------------------------------
981 INTEGER I, J
982C REAL
983 my_real
984 . r
985C------------------------------------
986C
987 DO i=1,3
988 DO j=1,3
989 k(i,j)= k(i,j)*jt(i)*jt(j)
990 ENDDO
991 ENDDO
992 r = zero
993 DO i=1,3
994 DO j=1,3
995 r=r+abs(k(i,j))
996 ENDDO
997 ENDDO
998 IF (r<em30) THEN
999 istif = 0
1000 ELSE
1001 istif = 1
1002 ENDIF
1003C
1004 RETURN

◆ updk_bc()

subroutine updk_bc ( integer, dimension(3) jt,
integer, dimension(3) jr,
k,
integer istif )

Definition at line 614 of file rbe3_imp0.F.

615C-----------------------------------------------
616C I m p l i c i t T y p e s
617C-----------------------------------------------
618#include "implicit_f.inc"
619C-----------------------------------------------
620C D u m m y A r g u m e n t s
621C-----------------------------------------------
622 INTEGER JT(3),JR(3),ISTIF
623C REAL
624 my_real
625 . k(6,6)
626C-----------------------------------------------
627C L o c a l V a r i a b l e s
628C-----------------------------------------------
629 INTEGER I, J
630C REAL
631 my_real
632 . r
633C------------------------------------
634C
635 DO i=1,3
636 DO j=1,3
637 k(i,j)= k(i,j)*jt(i)*jt(j)
638 k(i,j+3)= k(i,j+3)*jt(i)*jr(j)
639 k(i+3,j)= k(i+3,j)*jr(i)*jt(j)
640 k(i+3,j+3)= k(i+3,j+3)*jr(i)*jr(j)
641 ENDDO
642 ENDDO
643 r = zero
644 DO i=1,6
645 DO j=1,6
646 r=r+abs(k(i,j))
647 ENDDO
648 ENDDO
649 IF (r<em30) THEN
650 istif = 0
651 ELSE
652 istif = 1
653 ENDIF
654C
655 RETURN

◆ updk_bc2()

subroutine updk_bc2 ( integer, dimension(3) jt,
integer, dimension(3) jr,
k,
integer istif )

Definition at line 662 of file rbe3_imp0.F.

663C-----------------------------------------------
664C I m p l i c i t T y p e s
665C-----------------------------------------------
666#include "implicit_f.inc"
667C-----------------------------------------------
668C D u m m y A r g u m e n t s
669C-----------------------------------------------
670 INTEGER JT(3),JR(3),ISTIF
671C REAL
672 my_real
673 . k(6,6)
674C-----------------------------------------------
675C L o c a l V a r i a b l e s
676C-----------------------------------------------
677 INTEGER I, J
678C REAL
679 my_real
680 . r
681C------------------------------------
682C
683 DO i=1,3
684 DO j=1,3
685 k(i,j)= k(i,j)*jt(j)
686 k(i,j+3)= k(i,j+3)*jr(j)
687 k(i+3,j)= k(i+3,j)*jt(j)
688 k(i+3,j+3)= k(i+3,j+3)*jr(j)
689 ENDDO
690 ENDDO
691 r=zero
692 DO i=1,6
693 DO j=1,6
694 r=r+abs(k(i,j))
695 ENDDO
696 ENDDO
697 IF (r<em30) THEN
698 istif = 0
699 ELSE
700 istif = 1
701 ENDIF
702C
703 RETURN

◆ updk_cdi()

subroutine updk_cdi ( fdi,
mdi,
kdd,
kij,
integer irot,
integer nd,
integer isym )

Definition at line 909 of file rbe3_imp0.F.

910C-----------------------------------------------
911C I m p l i c i t T y p e s
912C-----------------------------------------------
913#include "implicit_f.inc"
914C-----------------------------------------------
915C D u m m y A r g u m e n t s
916C-----------------------------------------------
917 INTEGER IROT,ND,ISYM
918C REAL
919 my_real
920 . fdi(3,6),mdi(3,6),kdd(6,6),kij(6,6)
921C-----------------------------------------------
922C L o c a l V a r i a b l e s
923C-----------------------------------------------
924 INTEGER I, J,K,L
925C REAL
926C-------Update KIJ=[KDD]CDI---
927 DO i=1,6
928 DO j=1,6
929 kij(i,j)=zero
930 ENDDO
931 ENDDO
932C---- FDI[KDD]------
933 DO i=1,nd
934 DO j=1,3
935 DO k=1,nd
936 kij(i,j)=kij(i,j)+kdd(i,k)*fdi(j,k)
937 ENDDO
938 ENDDO
939 ENDDO
940 IF (irot>0) THEN
941C---- MDI[KDD]------
942 DO i=1,nd
943 DO j=1,3
944 DO k=1,nd
945 kij(i,j+3)=kij(i,j+3)+kdd(i,k)*mdi(j,k)
946 ENDDO
947 ENDDO
948 ENDDO
949 ENDIF
950C
951 IF (isym==1) THEN
952 DO i=1,6
953 DO j=1,6
954 kij(i,j)=kij(i,j)+kij(j,i)
955 ENDDO
956 ENDDO
957 ENDIF
958C
959 RETURN

◆ updk_cdii()

subroutine updk_cdii ( fdi,
mdi,
kdd,
kii,
integer irot,
integer nd )

Definition at line 756 of file rbe3_imp0.F.

757C-----------------------------------------------
758C I m p l i c i t T y p e s
759C-----------------------------------------------
760#include "implicit_f.inc"
761C-----------------------------------------------
762C D u m m y A r g u m e n t s
763C-----------------------------------------------
764 INTEGER IROT,ND
765C REAL
766 my_real
767 . fdi(3,6),mdi(3,6),kdd(6,6),kii(6,6)
768C-----------------------------------------------
769C L o c a l V a r i a b l e s
770C-----------------------------------------------
771 INTEGER I, J,K,L
772C REAL
773C-------Update KII=CDI^t[KDD]CDI----FDI=CDI^t
774 DO i=1,6
775 DO j=i,6
776 kii(i,j)=zero
777 ENDDO
778 ENDDO
779C---- FDI[KDD]FDI^t------
780 DO i=1,3
781 DO j=i,3
782 DO k=1,nd
783 DO l=1,nd
784 kii(i,j)=kii(i,j)+fdi(i,k)*kdd(k,l)*fdi(j,l)
785 ENDDO
786 ENDDO
787 ENDDO
788 ENDDO
789 DO i=1,3
790 DO j=i,3
791 kii(j,i)=kii(i,j)
792 ENDDO
793 ENDDO
794 IF (irot>0) THEN
795C---- MDI[KDD]MDI^t------
796 DO i=1,3
797 DO j=i,3
798 DO k=1,nd
799 DO l=1,nd
800 kii(i+3,j+3)=kii(i+3,j+3)+mdi(i,k)*kdd(k,l)*mdi(j,l)
801 ENDDO
802 ENDDO
803 ENDDO
804 ENDDO
805C---- FDI[KDD]MDI^t------
806 DO i=1,3
807 DO j=1,3
808 DO k=1,nd
809 DO l=1,nd
810 kii(i,j+3)=kii(i,j+3)+fdi(i,k)*kdd(k,l)*mdi(j,l)
811 ENDDO
812 ENDDO
813 ENDDO
814 ENDDO
815 DO i=1,3
816 DO j=1,3
817 kii(i+3,j)=kii(j,i+3)
818 ENDDO
819 ENDDO
820 DO i=1,3
821 DO j=i,3
822 kii(j+3,i+3)=kii(i+3,j+3)
823 ENDDO
824 ENDDO
825 ENDIF
826C
827 RETURN

◆ updk_cdij()

subroutine updk_cdij ( fdi,
mdi,
fdj,
mdj,
kdd,
kij,
integer irot,
integer nd )

Definition at line 835 of file rbe3_imp0.F.

836C-----------------------------------------------
837C I m p l i c i t T y p e s
838C-----------------------------------------------
839#include "implicit_f.inc"
840C-----------------------------------------------
841C D u m m y A r g u m e n t s
842C-----------------------------------------------
843 INTEGER IROT,ND
844C REAL
845 my_real
846 . fdi(3,6),mdi(3,6),fdj(3,6),mdj(3,6),kdd(6,6),kij(6,6)
847C-----------------------------------------------
848C L o c a l V a r i a b l e s
849C-----------------------------------------------
850 INTEGER I, J,K,L
851C REAL
852C-------Update KII=CDI^t[KDD]CDJ---
853 DO i=1,6
854 DO j=1,6
855 kij(i,j)=zero
856 ENDDO
857 ENDDO
858C---- FDI[KDD]FDJ^t------
859 DO i=1,3
860 DO j=1,3
861 DO k=1,nd
862 DO l=1,nd
863 kij(i,j)=kij(i,j)+fdi(i,k)*kdd(k,l)*fdj(j,l)
864 ENDDO
865 ENDDO
866 ENDDO
867 ENDDO
868 IF (irot>0) THEN
869C---- MDI[KDD]MDJ^t------
870 DO i=1,3
871 DO j=1,3
872 DO k=1,nd
873 DO l=1,nd
874 kij(i+3,j+3)=kij(i+3,j+3)+mdi(i,k)*kdd(k,l)*mdj(j,l)
875 ENDDO
876 ENDDO
877 ENDDO
878 ENDDO
879C---- FDI[KDD]MDI^t------
880 DO i=1,3
881 DO j=1,3
882 DO k=1,nd
883 DO l=1,nd
884 kij(i,j+3)=kij(i,j+3)+fdi(i,k)*kdd(k,l)*mdj(j,l)
885 ENDDO
886 ENDDO
887 ENDDO
888 ENDDO
889C---- MDI[KDD]MDJ^t------
890 DO i=1,3
891 DO j=1,3
892 DO k=1,nd
893 DO l=1,nd
894 kij(i+3,j)=kij(i+3,j)+mdi(i,k)*kdd(k,l)*fdj(j,l)
895 ENDDO
896 ENDDO
897 ENDDO
898 ENDDO
899 ENDIF
900C
901 RETURN