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

Go to the source code of this file.

Functions/Subroutines

subroutine rby_imp0 (x, rby, lpby, npby, skew, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
subroutine rby_impi (x, rby, lpby, npby, skew, nrbyac, irbyac, nss, iss, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
subroutine rby_imp1 (x, rby, nod, nby, nsc, isi, ns, nods, skew, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
subroutine rby_impm (x, nmc, imi, isi, skew, iskew, itab, weight, ms, in, iadk, jdik, lt_k, ndof, iddl)
subroutine updkb_rb (ndl, xs, ys, zs, kdd, bd)
subroutine updkb_rb1 (ni, nj, xs, ys, zs, kdd)
subroutine updkb_rb2 (ni, nj, xs, ys, zs, xs1, ys1, zs1, kdd, isym)
subroutine rby_impf (x, m, n, ndof, a, ar)
subroutine updfr_rb (xs, ys, zs, kii, k)
subroutine rby_impr1 (x, rby, nod, nby, ndof, iddl, b)
subroutine updb_rb (ndl, xs, ys, zs, bd)
subroutine rby_impr2 (x, rby, nod, nby, ndof, iddl, b, ac, acr)
subroutine rby_frk (ns, m, x, itab, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, idlm, iss, ism)

Function/Subroutine Documentation

◆ rby_frk()

subroutine rby_frk ( integer ns,
integer m,
x,
integer, dimension(*) itab,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iddlm,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
a,
kss,
ksm,
knm,
krm,
integer idlm,
integer iss,
integer ism )

Definition at line 890 of file rby_imp0.F.

894C-----------------------------------------------
895C I m p l i c i t T y p e s
896C-----------------------------------------------
897#include "implicit_f.inc"
898C-----------------------------------------------
899C D u m m y A r g u m e n t s
900C-----------------------------------------------
901 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
902 . M, NS,ITAB(*),IDLM ,ISS,ISM
903 my_real
904 . x(3,*),diag_k(*),lt_k(*),b(*),a(3,*),
905 . kss(6),ksm(3,3),knm(3,3),krm(3,3)
906C-----------------------------------------------
907C L o c a l V a r i a b l e s
908C-----------------------------------------------
909 INTEGER I, J, K,ID,NL,NI,NJ,NDOFI,ND,IR,IDM
910 my_real kdd(6,6),bd(6),xs,ys,zs
911C------------------------------------
912C VITESSES DES NOEUDS SECONDS
913C------------------------------------
914 i=ns
915 ndofi = 3
916 nd = 6
917C-----
918 xs=x(1,i)-x(1,m)
919 ys=x(2,i)-x(2,m)
920 zs=x(3,i)-x(3,m)
921 IF (iss>0) THEN
922 DO k=1,ndofi
923 bd(k) = a(k,i)
924 kdd(k,k) = kss(k)
925 ENDDO
926 DO k=ndofi+1,6
927 bd(k)=zero
928 ENDDO
929 kdd(1,2) = kss(4)
930 kdd(1,3) = kss(5)
931 kdd(2,3) = kss(6)
932 CALL updkb_rb(ndofi,xs,ys,zs,kdd,bd)
933 CALL put_kmii(idlm,iadk,diag_k,lt_k,kdd,nd)
934 ENDIF
935 IF (ism>0) THEN
936C--------no diag--Kjm=sum(KjsCsm)--
937 DO k=1,ndofi
938 DO j=1,ndofi
939 kdd(k,j) = ksm(k,j)
940 ENDDO
941 ENDDO
942C------- Update ---
943 CALL updkb_rb1(ndofi,ndofi,xs,ys,zs,kdd)
944 DO k=1,ndofi
945 DO j=1,ndofi
946 knm(k,j)=kdd(j,k)
947 krm(k,j)=kdd(j,k+ndofi)
948 ENDDO
949 ENDDO
950 ENDIF
951C
952 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
put_kmii
subroutine put_kmii(id, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:1186
updkb_rb
subroutine updkb_rb(ndl, xs, ys, zs, kdd, bd)
Definition rby_imp0.F:324
updkb_rb1
subroutine updkb_rb1(ni, nj, xs, ys, zs, kdd)
Definition rby_imp0.F:425

◆ rby_imp0()

subroutine rby_imp0 ( x,
rby,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
skew,
integer nrbyac,
integer, dimension(*) irbyac,
integer, dimension(*) nsc,
integer, dimension(*) isij,
integer nmc,
integer, dimension(*) imij,
integer, dimension(*) nss,
integer, dimension(*) iss,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
b )

Definition at line 31 of file rby_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"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*),
50 . NRBYAC,IRBYAC(*),NDDL,IADK(*),JDIK(*),NDOF(*),
51 . IDDL(*),IKC(*),NSC(*),ISIJ(*),NSS(*) ,ISS(*),
52 . NMC,IMIJ(*)
53 my_real
54 . x(3,*), rby(nrby,*), skew(lskew,*),
55 . in(*),ms(*),diag_k(*),lt_k(*),b(*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, N,K,NK,NN,J,K1
60C-----------------------------------------------
61 k=1
62 nk=1
63 nn=1
64 DO i=1,nrbyac
65 n=irbyac(i)
66 k1=irbyac(i+nrbykin)+1
67 CALL rby_imp1(x, rby(1,n),lpby(k1),npby(1,n),
68 1 nsc(i),isij(nk),nss(k),iss(nn),
69 2 skew,iskew,itab,weight,ms,in,
70 3 nddl ,iadk ,jdik ,diag_k ,
71 4 lt_k ,ndof ,iddl ,ikc ,b )
72 DO j=1,npby(2,n)
73 nn = nn + nss(k+j-1)
74 ENDDO
75 k = k + npby(2,n)
76 nk = nk + 2*nsc(i)
77 ENDDO
78C
79 IF (nmc>0)
80 . CALL rby_impm(x ,nmc ,imij ,isij(nk),skew ,
81 1 iskew,itab ,weight,ms ,in ,
82 2 iadk ,jdik ,lt_k ,ndof ,iddl )
83C
84 RETURN
rby_impm
subroutine rby_impm(x, nmc, imi, isi, skew, iskew, itab, weight, ms, in, iadk, jdik, lt_k, ndof, iddl)
Definition rby_imp0.F:266
rby_imp1
subroutine rby_imp1(x, rby, nod, nby, nsc, isi, ns, nods, skew, iskew, itab, weight, ms, in, nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b)
Definition rby_imp0.F:160

◆ rby_imp1()

subroutine rby_imp1 ( x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
integer nsc,
integer, dimension(2,nsc) isi,
integer, dimension(*) ns,
integer, dimension(*) nods,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
b )

Definition at line 155 of file rby_imp0.F.

160C-----------------------------------------------
161C I m p l i c i t T y p e s
162C-----------------------------------------------
163#include "implicit_f.inc"
164C-----------------------------------------------
165C C o m m o n B l o c k s
166C-----------------------------------------------
167#include "param_c.inc"
168C-----------------------------------------------
169C D u m m y A r g u m e n t s
170C-----------------------------------------------
171 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*),
172 . NSC,ISI(2,NSC) ,NS(*),NODS(*)
173 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
174 my_real
175 . x(3,*), rby(*), skew(lskew,*),
176 . in(*),ms(*),diag_k(*),lt_k(*),b(*)
177C-----------------------------------------------
178C L o c a l V a r i a b l e s
179C-----------------------------------------------
180C ds010 21/2/00 +1
181 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
182 . K,L,ID,JD,ND,IMD,NIDOF,IR
183C REAL
184 my_real
185 . xs,ys,zs,xs1,ys1,zs1, kdd(6,6),bd(6)
186C-----------------------------------------------
187 m =nby(1)
188C -------main utilise place de premier secnd node (just like change node number)
189 IF (m<0) RETURN
190 nsn =nby(2)
191 imd = iddl(m)+1
192 nd = 6
193C--------boucle secnd nodes--
194 j1=0
195 DO i=1,nsn
196C--------block diagonal Kmm--
197 n = nod(i)
198 IF (ndof(n)>0) THEN
199 xs=x(1,n)-x(1,m)
200 ys=x(2,n)-x(2,m)
201 zs=x(3,n)-x(3,m)
202 DO k=1,ndof(n)
203 id = iddl(n)+k
204 ikc(id)=7
205 bd(k)=b(id)
206 ENDDO
207 DO k=ndof(n)+1,nd
208 bd(k)=zero
209 ENDDO
210 CALL get_kii(n ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(n))
211 CALL updkb_rb(ndof(n),xs,ys,zs,kdd,bd)
212C-------Update K,B---
213 CALL put_kii(m ,iddl ,iadk,diag_k,lt_k ,kdd,nd)
214 DO k=1,nd
215 id = imd+k-1
216 b(id) = b(id) + bd(k)
217 ENDDO
218C--------no diag--Kjm=sum(KjsCsm)--
219 DO j = 1,ns(i)
220 ni=nods(j1+j)
221 nidof=ndof(ni)
222 CALL get_kij(ni,n,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(n),ir)
223 IF (ir==1) CALL print_wkij(itab(ni) ,itab(n) ,1 )
224 CALL updkb_rb1(nidof,ndof(n),xs,ys,zs,kdd)
225C------- Update ---
226 CALL put_kij(ni,m,iddl,iadk,jdik,lt_k,kdd,nidof,nd,ir)
227 IF (ir==1) CALL print_wkij(itab(ni) ,itab(m) ,1 )
228 ENDDO
229 j1=j1+ns(i)
230 ENDIF
231 ENDDO
232C-------fin -boucle secnd nodes--
233C--------due au coupled block KIJ--
234 DO i=1,nsc
235 ni =isi(1,i)
236 nj =isi(2,i)
237 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
238 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,1 )
239 xs=x(1,ni)-x(1,m)
240 ys=x(2,ni)-x(2,m)
241 zs=x(3,ni)-x(3,m)
242 xs1=x(1,nj)-x(1,m)
243 ys1=x(2,nj)-x(2,m)
244 zs1=x(3,nj)-x(3,m)
245 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,1)
246C--------update --
247 CALL put_kii(m ,iddl ,iadk,diag_k,lt_k ,kdd,nd)
248c write(*,*)'2 lt_k(2)=',lt_k(2),kdd(1,3),i
249 ENDDO
250C
251 RETURN
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:890
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
id
initmumps id
Definition multiplerhs_example.m:4
updkb_rb2
subroutine updkb_rb2(ni, nj, xs, ys, zs, xs1, ys1, zs1, kdd, isym)
Definition rby_imp0.F:489

◆ rby_impf()

subroutine rby_impf ( x,
integer m,
integer n,
integer, dimension(*) ndof,
a,
ar )

Definition at line 611 of file rby_imp0.F.

612C-----------------------------------------------
613C I m p l i c i t T y p e s
614C-----------------------------------------------
615#include "implicit_f.inc"
616C-----------------------------------------------
617C D u m m y A r g u m e n t s
618C-----------------------------------------------
619 INTEGER N, M,NDOF(*)
620C REAL
621 my_real
622 . x(3,*), a(3,*),ar(3,*)
623C-----------------------------------------------
624C L o c a l V a r i a b l e s
625C-----------------------------------------------
626C REAL
627 my_real
628 . xs,ys,zs
629C-----------------------------------------------
630 IF (m<0) RETURN
631 a(1,m)=a(1,m)+a(1,n)
632 a(2,m)=a(2,m)+a(2,n)
633 a(3,m)=a(3,m)+a(3,n)
634 IF (ndof(m)==6) THEN
635 xs=x(1,n)-x(1,m)
636 ys=x(2,n)-x(2,m)
637 zs=x(3,n)-x(3,m)
638 ar(1,m)=ar(1,m)-a(2,n)*zs+a(3,n)*ys
639 ar(2,m)=ar(2,m)+a(1,n)*zs-a(3,n)*xs
640 ar(3,m)=ar(3,m)-a(1,n)*ys+a(2,n)*xs
641 ENDIF
642C
643 RETURN

◆ rby_impi()

subroutine rby_impi ( x,
rby,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
skew,
integer nrbyac,
integer, dimension(*) irbyac,
integer, dimension(*) nss,
integer, dimension(*) iss,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
b )

Definition at line 93 of file rby_imp0.F.

98C-----------------------------------------------
99C I m p l i c i t T y p e s
100C-----------------------------------------------
101#include "implicit_f.inc"
102C-----------------------------------------------
103C C o m m o n B l o c k s
104C-----------------------------------------------
105#include "com04_c.inc"
106#include "param_c.inc"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
110 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*),
111 . NRBYAC,IRBYAC(*),NDDL,IADK(*),JDIK(*),NDOF(*),
112 . IDDL(*),IKC(*),NSS(*) ,ISS(*)
113 my_real
114 . x(3,*), rby(nrby,*), skew(lskew,*),
115 . in(*),ms(*),diag_k(*),lt_k(*),b(*)
116C-----------------------------------------------
117C L o c a l V a r i a b l e s
118C-----------------------------------------------
119 INTEGER I, N,K,NN,J,NSC,ISIJ,K1
120C-----------------------------------------------
121 nsc=0
122 k=1
123 nn=1
124 DO i=1,nrbyac
125 n=irbyac(i)
126 k1=irbyac(i+nrbykin)+1
127 CALL rby_imp1(x, rby(1,n),lpby(k1),npby(1,n),
128 1 nsc ,isij ,nss(k),iss(nn),
129 2 skew,iskew,itab,weight,ms,in,
130 3 nddl ,iadk ,jdik ,diag_k ,
131 4 lt_k ,ndof ,iddl ,ikc ,b )
132 DO j=1,npby(2,n)
133 nn = nn + nss(k+j-1)
134 ENDDO
135 k = k + npby(2,n)
136 ENDDO
137C
138 RETURN

◆ rby_impm()

subroutine rby_impm ( x,
integer nmc,
integer, dimension(2,nmc) imi,
integer, dimension(2,nmc) isi,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
lt_k,
integer, dimension(*) ndof,
integer, dimension(*) iddl )

Definition at line 263 of file rby_imp0.F.

266C-----------------------------------------------
267C I m p l i c i t T y p e s
268C-----------------------------------------------
269#include "implicit_f.inc"
270C-----------------------------------------------
271C C o m m o n B l o c k s
272C-----------------------------------------------
273#include "param_c.inc"
274C-----------------------------------------------
275C D u m m y A r g u m e n t s
276C-----------------------------------------------
277 INTEGER ISKEW(*),ITAB(*), WEIGHT(*),
278 . NMC,IMI(2,NMC) ,ISI(2,NMC)
279 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*)
280C REAL
281 my_real
282 . skew(lskew,*),x(3,*), in(*),ms(*),lt_k(*)
283C-----------------------------------------------
284C L o c a l V a r i a b l e s
285C-----------------------------------------------
286C ds010 21/2/00 +1
287 INTEGER M, I, NI,NJ,ND,NM,IR
288C REAL
289 my_real
290 . xs,ys,zs,xs1,ys1,zs1, kdd(6,6)
291C-----------------------------------------------
292 nd=6
293 DO i=1,nmc
294 ni =isi(1,i)
295 nj =isi(2,i)
296 m =imi(1,i)
297 nm =imi(2,i)
298 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
299 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,1 )
300 xs=x(1,ni)-x(1,m)
301 ys=x(2,ni)-x(2,m)
302 zs=x(3,ni)-x(3,m)
303 xs1=x(1,nj)-x(1,nm)
304 ys1=x(2,nj)-x(2,nm)
305 zs1=x(3,nj)-x(3,nm)
306 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
307C--------update --
308 CALL put_kij(m ,nm ,iddl ,iadk,jdik,lt_k,kdd,nd,nd,ir)
309 IF (ir==1) CALL print_wkij(itab(m) ,itab(nm) ,1 )
310 ENDDO
311C
312 RETURN

◆ rby_impr1()

subroutine rby_impr1 ( x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 705 of file rby_imp0.F.

707C-----------------------------------------------
708C I m p l i c i t T y p e s
709C-----------------------------------------------
710#include "implicit_f.inc"
711C-----------------------------------------------
712C C o m m o n B l o c k s
713C-----------------------------------------------
714C-----------------------------------------------
715C D u m m y A r g u m e n t s
716C-----------------------------------------------
717 INTEGER NOD(*), NBY(*),NDOF(*),IDDL(*)
718C REAL
719 my_real
720 . x(3,*), rby(*), b(*)
721C-----------------------------------------------
722C L o c a l V a r i a b l e s
723C-----------------------------------------------
724C ds010 21/2/00 +1
725 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
726 . K,L,ID,JD,ND,IMD,NIDOF
727C REAL
728 my_real
729 . xs,ys,zs,bd(6)
730C-----------------------------------------------
731 m =nby(1)
732C -------main utilise place de premier secnd node (just like change node number)
733 IF ((m<0).OR.ndof(m)==0) RETURN
734 nsn =nby(2)
735 nd = 6
736C--------boucle secnd nodes--
737 j1=0
738 DO i=1,nsn
739C--------block diagonal Kmm--
740 n = nod(i)
741 IF (ndof(n)>0) THEN
742 xs=x(1,n)-x(1,m)
743 ys=x(2,n)-x(2,m)
744 zs=x(3,n)-x(3,m)
745 DO k=1,ndof(n)
746 id = iddl(n)+k
747 bd(k)=b(id)
748 ENDDO
749 DO k=ndof(n)+1,nd
750 bd(k)=zero
751 ENDDO
752 CALL updb_rb(ndof(n),xs,ys,zs,bd)
753C-------Update B---
754 DO k=1,nd
755 id = iddl(m)+k
756 b(id) = b(id) + bd(k)
757 ENDDO
758 ENDIF
759 ENDDO
760C
761 RETURN
updb_rb
subroutine updb_rb(ndl, xs, ys, zs, bd)
Definition rby_imp0.F:773

◆ rby_impr2()

subroutine rby_impr2 ( x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
ac,
acr )

Definition at line 818 of file rby_imp0.F.

820C-----------------------------------------------
821C I m p l i c i t T y p e s
822C-----------------------------------------------
823#include "implicit_f.inc"
824C-----------------------------------------------
825C C o m m o n B l o c k s
826C-----------------------------------------------
827C-----------------------------------------------
828C D u m m y A r g u m e n t s
829C-----------------------------------------------
830 INTEGER NOD(*), NBY(*),NDOF(*),IDDL(*)
831C REAL
832 my_real
833 . x(3,*), rby(*), b(*)
834C-----------------------------------------------
835C L o c a l V a r i a b l e s
836C-----------------------------------------------
837C ds010 21/2/00 +1
838 INTEGER M, NSN, IJD, ISK, I, N, J,NI,NJ,J1,
839 . K,L,ID,JD,ND,IMD,NIDOF
840C REAL
841 my_real
842 . xs,ys,zs,bd(6),ac(3,*) ,acr(3,*)
843C-----------------------------------------------
844 m =nby(1)
845C -------main utilise place de premier secnd node (just like change node number)
846 IF (m<0) RETURN
847 nsn =nby(2)
848 nd = 6
849C--------boucle secnd nodes--
850 j1=0
851 DO i=1,nsn
852C--------block diagonal Kmm--
853 n = nod(i)
854 IF (ndof(n)==0) THEN
855 xs=x(1,n)-x(1,m)
856 ys=x(2,n)-x(2,m)
857 zs=x(3,n)-x(3,m)
858 DO k=1,3
859 bd(k)=ac(k,n)
860 bd(k+3)=acr(k,n)
861 ENDDO
862 CALL updb_rb(nd,xs,ys,zs,bd)
863C-------Update B---
864 IF (ndof(m)==0) THEN
865 DO k=1,3
866 ac(k,m)=ac(k,m)+bd(k)
867 acr(k,m)=acr(k,m)+bd(k+3)
868 ENDDO
869 ELSE
870 DO k=1,nd
871 id = iddl(m)+k
872 b(id) = b(id) + bd(k)
873 ENDDO
874 ENDIF
875 ENDIF
876 ENDDO
877C
878 RETURN

◆ updb_rb()

subroutine updb_rb ( integer ndl,
xs,
ys,
zs,
bd )

Definition at line 772 of file rby_imp0.F.

773C-----------------------------------------------
774C I m p l i c i t T y p e s
775C-----------------------------------------------
776#include "implicit_f.inc"
777C-----------------------------------------------
778C D u m m y A r g u m e n t s
779C-----------------------------------------------
780 INTEGER NDL
781C REAL
782 my_real
783 . xs,ys,zs, bd(6)
784C-----------------------------------------------
785C L o c a l V a r i a b l e s
786C-----------------------------------------------
787 INTEGER I, J, MI,MJ
788C REAL
789 my_real
790 . b(3)
791C------------------------------------
792C-------------produit B'=[CDI]^tB
793c-----with [CDI]=-[[I] [R]]-----
794c---- [[0] [I]]-----
795C
796 IF (ndl==6) THEN
797 b(1)=-bd(2)*zs+bd(3)*ys
798 b(2)= bd(1)*zs-bd(3)*xs
799 b(3)=-bd(1)*ys+bd(2)*xs
800 DO i=1,3
801 mi=i+3
802 bd(mi)= bd(mi)+b(i)
803 ENDDO
804 ENDIF
805C
806 RETURN

◆ updfr_rb()

subroutine updfr_rb ( xs,
ys,
zs,
kii,
k )

Definition at line 651 of file rby_imp0.F.

652C-----------------------------------------------
653C I m p l i c i t T y p e s
654C-----------------------------------------------
655#include "implicit_f.inc"
656C-----------------------------------------------
657C D u m m y A r g u m e n t s
658C-----------------------------------------------
659 INTEGER NDL
660C REAL
661 my_real
662 . xs,ys,zs, k(6),kii(6)
663C-----------------------------------------------
664C L o c a l V a r i a b l e s
665C-----------------------------------------------
666 INTEGER I
667C REAL
668 my_real
669 . kdd(3,3),kr(3,3)
670C------------------------------------
671C-------------produit {K'}=[CDI]^t[K][CDI]
672c-----with [CDI]=-[[I] [R]]-----
673 DO i=1,3
674 kdd(i,i)=kii(i)
675 k(i)=k(i)+kii(i)
676 ENDDO
677 kdd(1,2)=kii(4)
678 kdd(1,3)=kii(5)
679 kdd(2,3)=kii(6)
680 kdd(2,1)=kdd(1,2)
681 kdd(3,1)=kdd(1,3)
682 kdd(3,2)=kdd(2,3)
683 DO i=1,3
684 kr(i,1)=-kdd(i,2)*zs+kdd(i,3)*ys
685 kr(i,2)= kdd(i,1)*zs-kdd(i,3)*xs
686 kr(i,3)=-kdd(i,1)*ys+kdd(i,2)*xs
687 ENDDO
688C
689 k(4)=k(4)-kr(2,1)*zs+kr(3,1)*ys
690 k(5)=k(5)+kr(1,2)*zs-kr(3,2)*xs
691 k(6)=k(6)-kr(1,3)*ys+kr(2,3)*xs
692C
693 RETURN

◆ updkb_rb()

subroutine updkb_rb ( integer ndl,
xs,
ys,
zs,
kdd,
bd )

Definition at line 323 of file rby_imp0.F.

324C-----------------------------------------------
325C I m p l i c i t T y p e s
326C-----------------------------------------------
327#include "implicit_f.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER NDL
332C REAL
333 my_real
334 . xs,ys,zs, bd(6),kdd(6,6)
335C-----------------------------------------------
336C L o c a l V a r i a b l e s
337C-----------------------------------------------
338 INTEGER I, J, MI,MJ
339C REAL
340 my_real
341 . b(3),k(6,6),kr(3,3),rkr(3,3),rmf(3,3)
342C------------------------------------
343C-------------produit {K'}=[CDI]^t[K][CDI] B'=[CDI]^tB
344c-----with [CDI]=-[[I] [R]]-----
345c---- [[0] [I]]-----
346 kdd(2,1)=kdd(1,2)
347 kdd(3,1)=kdd(1,3)
348 kdd(3,2)=kdd(2,3)
349 DO i=1,3
350 kr(i,1)=-kdd(i,2)*zs+kdd(i,3)*ys
351 kr(i,2)= kdd(i,1)*zs-kdd(i,3)*xs
352 kr(i,3)=-kdd(i,1)*ys+kdd(i,2)*xs
353 ENDDO
354 DO i=1,3
355 rkr(1,i)=-kr(2,i)*zs+kr(3,i)*ys
356 rkr(2,i)= kr(1,i)*zs-kr(3,i)*xs
357 rkr(3,i)=-kr(1,i)*ys+kr(2,i)*xs
358 ENDDO
359C
360 DO i=1,3
361 DO j=1,3
362 mj=j+3
363 k(i,mj)=kr(i,j)
364 ENDDO
365 ENDDO
366 DO i=1,3
367 mi=i+3
368 DO j=1,3
369 mj=j+3
370 k(mi,mj)=rkr(i,j)
371 ENDDO
372 ENDDO
373C
374 IF (ndl==6) THEN
375 DO i=1,3
376 DO j=4,6
377 k(i,j)=k(i,j)+kdd(i,j)
378 ENDDO
379 ENDDO
380 DO i=1,3
381 j=i+3
382 rmf(1,i)=-kdd(2,j)*zs+kdd(3,j)*ys
383 rmf(2,i)= kdd(1,j)*zs-kdd(3,j)*xs
384 rmf(3,i)=-kdd(1,j)*ys+kdd(2,j)*xs
385 ENDDO
386 DO i=1,3
387 mi=i+3
388 DO j=i,3
389 mj=j+3
390 k(mi,mj)=k(mi,mj)+rmf(i,j)+rmf(j,i)+kdd(mi,mj)
391 ENDDO
392 ENDDO
393 b(1)=-bd(2)*zs+bd(3)*ys
394 b(2)= bd(1)*zs-bd(3)*xs
395 b(3)=-bd(1)*ys+bd(2)*xs
396 DO i=1,3
397 mi=i+3
398 bd(mi)= bd(mi)+b(i)
399 ENDDO
400 ENDIF
401C
402 DO i=1,3
403 DO j=4,6
404 kdd(i,j)=k(i,j)
405 ENDDO
406 ENDDO
407 DO i=4,6
408 DO j=i,6
409 kdd(i,j)=k(i,j)
410 ENDDO
411 ENDDO
412C
413 RETURN

◆ updkb_rb1()

subroutine updkb_rb1 ( integer ni,
integer nj,
xs,
ys,
zs,
kdd )

Definition at line 424 of file rby_imp0.F.

425C-----------------------------------------------
426C I m p l i c i t T y p e s
427C-----------------------------------------------
428#include "implicit_f.inc"
429C-----------------------------------------------
430C D u m m y A r g u m e n t s
431C-----------------------------------------------
432 INTEGER NI,NJ
433C REAL
434 my_real
435 . xs,ys,zs, kdd(6,6)
436C-----------------------------------------------
437C L o c a l V a r i a b l e s
438C-----------------------------------------------
439 INTEGER I, J
440C REAL
441 my_real
442 . k(6,6)
443C------------------------------------
444C-------------produit {K'}=-[K][CDI]
445c-----with [CDI]=-[[I] [R]]-----
446c---- [[0] [I]]-----
447C
448 DO i=1,6
449 DO j=1,6
450 k(i,j)=zero
451 ENDDO
452 ENDDO
453 DO i=1,ni
454 DO j=1,nj
455 k(i,j)=kdd(i,j)
456 ENDDO
457 ENDDO
458 DO i=1,3
459 k(i,4)=k(i,4)-kdd(i,2)*zs+kdd(i,3)*ys
460 k(i,5)=k(i,5)+kdd(i,1)*zs-kdd(i,3)*xs
461 k(i,6)=k(i,6)-kdd(i,1)*ys+kdd(i,2)*xs
462 ENDDO
463C
464 IF (ni==6) THEN
465 DO i=4,6
466 k(i,4)=k(i,4)-kdd(i,2)*zs+kdd(i,3)*ys
467 k(i,5)=k(i,5)+kdd(i,1)*zs-kdd(i,3)*xs
468 k(i,6)=k(i,6)-kdd(i,1)*ys+kdd(i,2)*xs
469 ENDDO
470 ENDIF
471C
472 DO i=1,6
473 DO j=1,6
474 kdd(i,j)=k(i,j)
475 ENDDO
476 ENDDO
477C
478 RETURN

◆ updkb_rb2()

subroutine updkb_rb2 ( integer ni,
integer nj,
xs,
ys,
zs,
xs1,
ys1,
zs1,
kdd,
integer isym )

Definition at line 488 of file rby_imp0.F.

489C-----------------------------------------------
490C I m p l i c i t T y p e s
491C-----------------------------------------------
492#include "implicit_f.inc"
493C-----------------------------------------------
494C D u m m y A r g u m e n t s
495C-----------------------------------------------
496 INTEGER NI,NJ,ISYM
497C REAL
498 my_real
499 . xs,ys,zs,xs1,ys1,zs1, kdd(6,6)
500C-----------------------------------------------
501C L o c a l V a r i a b l e s
502C-----------------------------------------------
503 INTEGER I, J, MI,MJ
504C REAL
505 my_real
506 . k(6,6),kr(3,3),rkr(3,3),rmf(3,3),rk(3,3)
507C------------------------------------
508C-------------produit {K'}=[CDI]^t[K][CDJ] +()^t
509c-----with [CDI]=-[[I] [R]]-----
510c---- [[0] [I]]-----
511C
512 DO i=1,3
513 kr(i,1)=-kdd(i,2)*zs1+kdd(i,3)*ys1
514 kr(i,2)= kdd(i,1)*zs1-kdd(i,3)*xs1
515 kr(i,3)=-kdd(i,1)*ys1+kdd(i,2)*xs1
516 ENDDO
517 DO i=1,3
518 rkr(1,i)=-kr(2,i)*zs+kr(3,i)*ys
519 rkr(2,i)= kr(1,i)*zs-kr(3,i)*xs
520 rkr(3,i)=-kr(1,i)*ys+kr(2,i)*xs
521 rk(1,i)=-kdd(2,i)*zs+kdd(3,i)*ys
522 rk(2,i)= kdd(1,i)*zs-kdd(3,i)*xs
523 rk(3,i)=-kdd(1,i)*ys+kdd(2,i)*xs
524 ENDDO
525C
526 DO i=1,3
527 mi=i+3
528 DO j=1,3
529 mj=j+3
530 k(i,j)=kdd(i,j)
531 k(i,mj)=kr(i,j)
532 k(mi,j)=rk(i,j)
533 k(mi,mj)=rkr(i,j)
534 ENDDO
535 ENDDO
536C
537 IF (ni==6) THEN
538 DO i=4,6
539 DO j=1,3
540 k(i,j)=k(i,j)+kdd(i,j)
541 ENDDO
542 ENDDO
543C---------FM Rj------------
544 DO i=1,3
545 j=i+3
546 rmf(i,1)=-kdd(j,2)*zs1+kdd(j,3)*ys1
547 rmf(i,2)= kdd(j,1)*zs1-kdd(j,3)*xs1
548 rmf(i,3)=-kdd(j,1)*ys1+kdd(j,2)*xs1
549 ENDDO
550 DO i=1,3
551 mi=i+3
552 DO j=1,3
553 mj=j+3
554 k(mi,mj)=k(mi,mj)+rmf(i,j)
555 ENDDO
556 ENDDO
557 ENDIF
558 IF (nj==6) THEN
559 DO i=1,3
560 DO j=4,6
561 k(i,j)=k(i,j)+kdd(i,j)
562 ENDDO
563 ENDDO
564C---------Ri^tMF------------
565 DO i=1,3
566 j=i+3
567 rmf(1,i)=-kdd(2,j)*zs+kdd(3,j)*ys
568 rmf(2,i)= kdd(1,j)*zs-kdd(3,j)*xs
569 rmf(3,i)=-kdd(1,j)*ys+kdd(2,j)*xs
570 ENDDO
571 DO i=1,3
572 mi=i+3
573 DO j=1,3
574 mj=j+3
575 k(mi,mj)=k(mi,mj)+rmf(i,j)
576 ENDDO
577 ENDDO
578 ENDIF
579 IF (ni==6.AND.nj==6) THEN
580 DO i=1,3
581 mi=i+3
582 DO j=1,3
583 mj=j+3
584 k(mi,mj)=k(mi,mj)+kdd(mi,mj)
585 ENDDO
586 ENDDO
587 ENDIF
588C
589 IF (isym==1) THEN
590 DO i=1,6
591 DO j=1,6
592 kdd(i,j)=k(i,j)+k(j,i)
593 ENDDO
594 ENDDO
595 ELSE
596 DO i=1,6
597 DO j=1,6
598 kdd(i,j)=k(i,j)
599 ENDDO
600 ENDDO
601 ENDIF
602C
603 RETURN