OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r8ke3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine r8ke3 (jft, jlt, nel, mtn, pm, geo, ixr, x, elbuf_tab, npf, tf, skew, offset, fr_wave, igeo, etag, iddl, ndof, k_diag, k_lt, iadk, jdik)
subroutine r8chk3 (jft, jlt, ngl, al, off, kx, ky, kz, mx, my, mz, r11, r12, r13, r21, r22, r23, r31, r32, r33)

Function/Subroutine Documentation

◆ r8chk3()

subroutine r8chk3 ( integer jft,
integer jlt,
integer, dimension(*) ngl,
al,
off,
kx,
ky,
kz,
mx,
my,
mz,
r11,
r12,
r13,
r21,
r22,
r23,
r31,
r32,
r33 )

Definition at line 146 of file r8ke3.F.

150C-----------------------------------------------
151C I m p l i c i t T y p e s
152C-----------------------------------------------
153#include "implicit_f.inc"
154C-----------------------------------------------
155C C o m m o n B l o c k s
156C-----------------------------------------------
157#include "impl1_c.inc"
158#include "comlock.inc"
159#include "units_c.inc"
160#include "scr17_c.inc"
161C-----------------------------------------------
162C D u m m y A r g u m e n t s
163C-----------------------------------------------
164 INTEGER JFT, JLT
165 INTEGER NGL(*)
166 my_real
167 . al(3,*),off(*),
168 . kx(*),ky(*),kz(*),
169 . mx(*),my(*),mz(*),
170 . r11(*),r12(*),r13(*),
171 . r21(*),r22(*),r23(*),
172 . r31(*),r32(*),r33(*)
173C-----------------------------------------------
174C L o c a l V a r i a b l e s
175C-----------------------------------------------
176 INTEGER I, J
177 my_real
178 . scal,alx,aly,alz,sx,sy,sz,s1,s2
179C-----------------------------------------------
180 IF (imp_chk > 0) THEN
181 scal = hundred
182 DO i=jft,jlt
183 IF(off(i)/=zero)THEN
184 alx = abs(al(1,i))*scal
185 aly = abs(al(2,i))*scal
186 alz = abs(al(2,i))*scal
187 s1 = ky(i)*alx-mz(i)
188 s2 = kz(i)*alx-my(i)
189 sx = max(s1,s2)
190 s1 = kx(i)*aly-mz(i)
191 s2 = kz(i)*aly-mx(i)
192 sy = max(s1,s2)
193 s1 = kx(i)*alz-my(i)
194 s2 = ky(i)*alz-mx(i)
195 sz = max(s1,s2)
196 IF(sx>zero.OR.sy>zero.OR.sz>zero)THEN
197#include "lockon.inc"
198 WRITE(iout ,2001) ngl(i)
199#include "lockoff.inc"
200 idel7nok = 1
201 imp_iw = imp_iw + 1
202 ENDIF
203 ENDIF
204 ENDDO
205 ENDIF
206C
207 RETURN
208 2001 FORMAT(/'***WARNING :SPRING TYPE8 NON-ZERO LENGTH : ELEMENT NB:',
209 . i8/)
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ r8ke3()

subroutine r8ke3 ( integer jft,
integer jlt,
integer nel,
integer mtn,
pm,
geo,
integer, dimension(nixr,*) ixr,
x,
type (elbuf_struct_), target elbuf_tab,
integer, dimension(*) npf,
tf,
skew,
integer offset,
fr_wave,
integer, dimension(*) igeo,
integer, dimension(*) etag,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
k_diag,
k_lt,
integer, dimension(*) iadk,
integer, dimension(*) jdik )

Definition at line 38 of file r8ke3.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE elbufdef_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59#include "param_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IXR(NIXR,*), NPF(*),JFT,JLT,OFFSET,NEL ,MTN
64 INTEGER IGEO(*),
65 . ETAG(*),IDDL(*) ,NDOF(*) ,IADK(*) ,JDIK(*)
66
67 my_real
68 . geo(npropg,*),x(*),tf(*),skew(lskew,*),
69 . fr_wave(*),pm(*),ke11(36,mvsiz),ke12(36,mvsiz),ke22(36,mvsiz),
70 . off(mvsiz),k_diag(*) ,k_lt(*)
71C
72 TYPE (ELBUF_STRUCT_), TARGET:: ELBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 my_real
77 . kx(mvsiz) ,ky(mvsiz) ,kz(mvsiz),
78 . mx(mvsiz) ,my(mvsiz) ,mz(mvsiz),
79 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
80 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
81 . r31(mvsiz),r32(mvsiz),r33(mvsiz),al0(mvsiz),al(3,mvsiz)
82 INTEGER PID(MVSIZ),NGL(MVSIZ)
83 INTEGER NB1, NB2, NB3, NB4, NB5, NB6, NB7, NB8, NB9, NB10,
84 . NB11, NB2A, NB2B, NB4A, NB4B, NB5A, NB5B, NB6A, NB6B, NB7A,
85 . NB7B, NB8A, NB8B, NB9A, NB9B, NB10A, NB10B, NB11A, NB11B,
86 . NB12, NB12A, NB12B, NB13, NB13A, NB13B, NB14, NEL3, NEL4,
87 . NB15, NB15A, NB15B, NB15C, NB15D, NB15E, NB15F, NB16,
88 . NB8C, NB8D,NBFI,IGTYP,I0,I,II(3)
89C
90 TYPE(G_BUFEL_) ,POINTER :: GBUF
91C-----------------------------------------------
92 gbuf => elbuf_tab%GBUF
93C
94C
95 DO i=1,3
96 ii(i) = (i-1)*nel + 1
97 ENDDO
98
99 CALL r2coork3(jft ,jlt ,x ,ixr ,pid ,
100 2 ngl ,r11 ,r12 ,r13 ,r21 ,
101 3 r22 ,r23 ,r31 ,r32 ,r33 ,
102 4 skew ,geo ,gbuf%OFF,off ,al ,
103 5 igeo )
104
105 DO i=jft,jlt
106 al0(i)=one
107 ENDDO
108
109 CALL r13mat3(jft ,jlt ,geo ,kx ,ky ,
110 2 kz ,mx ,my ,mz ,pid ,
111 3 al0 ,gbuf%FOR(ii(1)),gbuf%FOR(ii(2)),gbuf%FOR(ii(3)),gbuf%TOTDEPL(ii(1)),
112 4 gbuf%TOTDEPL(ii(2)),gbuf%TOTDEPL(ii(3)),gbuf%MOM(ii(1)),gbuf%MOM(ii(2)),gbuf%MOM(ii(3)),
113 5 gbuf%TOTROT(ii(1)),gbuf%TOTROT(ii(2)),gbuf%TOTROT(ii(3)),tf ,npf ,
114 6 gbuf%POSX,gbuf%POSY,gbuf%POSZ,gbuf%POSXX,gbuf%POSYY,
115 7 gbuf%POSZZ,igeo )
116C-------------------------
117C MATRICE de RIGIDITE
118C-------------------------
119 CALL r8sumg3 (jft ,jlt ,kx ,ky ,kz ,
120 2 mx ,my ,mz ,r11 ,r12 ,
121 3 r13 ,r21 ,r22 ,r23 ,r31 ,
122 4 r32 ,r33 ,ke11 ,ke12 ,ke22 )
123 CALL r8chk3(jft ,jlt ,ngl ,al ,off ,
124 1 kx ,ky ,kz ,mx ,my ,
125 2 mz ,r11 ,r12 ,r13 ,r21 ,
126 3 r22 ,r23 ,r31 ,r32 ,r33 )
127C ENDIF
128
129
130 IF (neig>0) CALL peoff(
131 1 nixr, jft, jlt, ixr, etag,
132 2 off )
133 CALL assem_p(nixr,6 ,
134 1 ixr ,nel ,iddl ,ndof ,k_diag ,
135 2 k_lt ,iadk ,jdik ,ke11 ,ke12 ,
136 3 ke22 ,off )
137C-----------------------------------------------
138 RETURN
assem_p
subroutine assem_p(nixpl, nd, ixp, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, kc11, kc12, kc22, off)
Definition assem_p.F:40
peoff
subroutine peoff(nixpl, jft, jlt, ixp, etag, off)
Definition peoff.F:35
r13mat3
subroutine r13mat3(jft, jlt, geo, kx, ky, kz, mx, my, mz, mgn, al0, fx, fy, fz, dx, dy, dz, xmom, ymom, zmom, rx, ry, rz, tf, npf, posx, posy, posz, posxx, posyy, poszz, igeo)
Definition r13mat3.F:38
r2coork3
subroutine r2coork3(jft, jlt, x, ncc, pid, ngl, r11, r12, r13, r21, r22, r23, r31, r32, r33, skew, geo, offg, off, al, igeo)
Definition r2coork3.F:33
r8chk3
subroutine r8chk3(jft, jlt, ngl, al, off, kx, ky, kz, mx, my, mz, r11, r12, r13, r21, r22, r23, r31, r32, r33)
Definition r8ke3.F:150
r8sumg3
subroutine r8sumg3(jft, jlt, kx, ky, kz, mx, my, mz, r11, r12, r13, r21, r22, r23, r31, r32, r33, ke11, ke12, ke22)
Definition r8sumg3.F:32