OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r13mat3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| r13mat3 ../engine/source/elements/spring/r13mat3.F
25!||--- called by ------------------------------------------------------
26!|| r13ke3 ../engine/source/elements/spring/r13ke3.F
27!|| r8ke3 ../engine/source/elements/spring/r8ke3.F
28!||--- calls -----------------------------------------------------
29!|| rkenonl ../engine/source/elements/spring/r4mat3.F
30!||====================================================================
31 SUBROUTINE r13mat3(JFT ,JLT ,GEO ,KX ,KY ,
32 1 KZ ,MX ,MY ,MZ ,MGN ,
33 2 AL0 ,FX ,FY ,FZ ,DX ,
34 3 DY ,DZ ,XMOM ,YMOM ,ZMOM ,
35 4 RX ,RY ,RZ ,TF ,NPF ,
36 5 POSX ,POSY ,POSZ ,POSXX ,POSYY ,
37 6 POSZZ ,IGEO )
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "param_c.inc"
50#include "impl1_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER JFT ,JLT, MGN(*),NPF(*),IGEO(NPROPGI,*)
55C REAL
56 my_real
57 . GEO(NPROPG,*), KX(*), KY(*), KZ(*), MX(*), MY(*), MZ(*),
58 . FX(*),FY(*),FZ(*),DX(*),DY(*),DZ(*),XMOM(*),YMOM(*),ZMOM(*),
59 . RX(*),RY(*),RZ(*),TF(*),POSX(*),POSY(*),POSZ(*),
60 . posxx(*),posyy(*),poszz(*),al0(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,ILEN,ILENG
65 INTEGER IECROU(MVSIZ), IFUNC(MVSIZ),IFUNC2(MVSIZ)
66C REAL
67 my_real
68 . ALI,A(MVSIZ)
69C-----------------------------------------------
70C
71 DO i=jft,jlt
72 kx(i)=geo(3,mgn(i))
73 ky(i)=geo(10,mgn(i))
74 kz(i)=geo(15,mgn(i))
75 ENDDO
76C---------------------
77C ROTATIONS
78C---------------------
79 DO i=jft,jlt
80 mx(i)=geo(19,mgn(i))
81 my(i)=geo(23,mgn(i))
82 mz(i)=geo(27,mgn(i))
83 ENDDO
84 ilen = 0
85 DO i=jft,jlt
86C KX(I)=GEO(41,MGN(I))*KX(I)
87C KY(I)=GEO(45,MGN(I))*KY(I)
88C KZ(I)=GEO(49,MGN(I))*KZ(I)
89C MX(I)=GEO(53,MGN(I))*MX(I)
90C MY(I)=GEO(57,MGN(I))*MY(I)
91C MZ(I)=GEO(61,MGN(I))*MZ(I)
92 ileng=nint(geo(93,mgn(i)))
93 IF(ileng/=0) ilen = 1
94 ENDDO
95 IF(ilen/=0) THEN
96 DO i=jft,jlt
97 ileng=nint(geo(93,mgn(i)))
98 IF(ileng/=0)THEN
99 ali = one/al0(i)
100 kx(i)=kx(i)*ali
101 ky(i)=ky(i)*ali
102 kz(i)=kz(i)*ali
103 mx(i)=mx(i)*ali
104 my(i)=my(i)*ali
105 mz(i)=mz(i)*ali
106 ENDIF
107 ENDDO
108 ENDIF
109 IF (ismdisp>0.OR.isprn==1) THEN
110C-----------KX------------
111 DO i=jft,jlt
112 iecrou(i)=nint(geo(7,mgn(i)))
113 ifunc(i) = igeo(101,mgn(i))
114 ifunc2(i)= igeo(103,mgn(i))
115 a(i) = geo(41,mgn(i))
116 ENDDO
117 CALL rkenonl(jft ,jlt ,kx ,fx ,dx ,
118 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
119 . npf ,posx )
120C-----------KY----------
121 DO i=jft,jlt
122 iecrou(i)=nint(geo(14,mgn(i)))
123 ifunc(i) = igeo(104,mgn(i))
124 ifunc2(i)= igeo(106,mgn(i))
125 a(i) = geo(45,mgn(i))
126 ENDDO
127 CALL rkenonl(jft ,jlt ,ky ,fy ,dy ,
128 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
129 . npf ,posy )
130C-----------KZ-----------
131 DO i=jft,jlt
132 iecrou(i)=nint(geo(18,mgn(i)))
133 ifunc(i) = igeo(107,mgn(i))
134 ifunc2(i)= igeo(109,mgn(i))
135 a(i) = geo(49,mgn(i))
136 ENDDO
137 CALL rkenonl(jft ,jlt ,kz ,fz ,dz ,
138 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
139 . npf ,posz )
140C-----------MX------------
141 DO i=jft,jlt
142 iecrou(i)=nint(geo(22,mgn(i)))
143 ifunc(i) = igeo(110,mgn(i))
144 ifunc2(i)= igeo(112,mgn(i))
145 a(i) = geo(53,mgn(i))
146 ENDDO
147 CALL rkenonl(jft ,jlt ,mx ,xmom ,rx ,
148 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
149 . npf ,posxx )
150C-----------MY------------
151 DO i=jft,jlt
152 iecrou(i)=nint(geo(26,mgn(i)))
153 ifunc(i) = igeo(113,mgn(i))
154 ifunc2(i)= igeo(115,mgn(i))
155 a(i) = geo(57,mgn(i))
156 ENDDO
157 CALL rkenonl(jft ,jlt ,my ,ymom ,ry ,
158 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
159 . npf ,posyy )
160C-----------MZ------------
161 DO i=jft,jlt
162 iecrou(i)=nint(geo(30,mgn(i)))
163 ifunc(i) = igeo(116,mgn(i))
164 ifunc2(i)= igeo(118,mgn(i))
165 a(i) = geo(61,mgn(i))
166 ENDDO
167 CALL rkenonl(jft ,jlt ,mz ,zmom ,rz ,
168 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
169 . npf ,poszz )
170 ENDIF
171C
172 RETURN
173 END
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
subroutine rkenonl(jft, jlt, kx, fx, dx, iecrou, ifunc, ifunc2, a, tf, npf, pos)
Definition r4mat3.F:108