OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rigid_mat.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!|| rigid_mat ../starter/source/materials/mat/mat019/rigid_mat.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| inepri ../starter/source/materials/mat/mat019/inepri.f
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.f
33!||====================================================================
34 SUBROUTINE rigid_mat(NRB, GNSL ,LSN , NSLNRM ,STIFN,
35 . STIFR, X, V ,MS ,IN ,
36 . RBYM, IRBYM ,LCRBM,NOM_OPT)
37 USE message_mod
38 USE names_and_titles_mod , ONLY : nchartitle
39C=======================================================================
40C RBY EN SORTIE DE INIRBY
41C a voir
42C 1 -> 9 : MATRICE ROTATION
43C 10 -> 12: INERTIES PRINCIPALES RBODY
44C 13: INERTIE MAIN INITIALE SPHERIQUE
45C 14: MASSE RBODY
46C 15: MASSE MAIN INITIALE
47C 17 -> 20: INERTIES DANS LE REPERE GLOBALE
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C A n a l y s e M o d u l e
54C-----------------------------------------------
55#include "scr17_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NRB,GNSL
60 INTEGER LSN(*), NSLNRM(*),IRBYM(NIRBYM,NRB) ,LCRBM(GNSL)
61 my_real rbym(nfrbym,*), ms(*), in(*), x(3,*),v(3,*), stifn(*),stifr(*)
62 INTEGER NOM_OPT(LNOPT1,*)
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "units_c.inc"
67#include "com04_c.inc"
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER J, NOSKEW, I, N, NONOD,ICDG,KK,NR,NSL,IR
72 my_real XG(3), XM0(3), XMG, XX, XY, XZ, YY, YZ, ZZ, XIIN, INMIN,
73 . masrb,dd,tol, ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9,rby(20)
74 INTEGER ID
75 CHARACTER(LEN=NCHARTITLE) :: TITR
76C
77 tol=one+em04
78 kk = 0
79 DO nr = 1, nrb
80 nsl = nslnrm(nr)
81 irbym(1,nr) = nr
82 irbym(2,nr) = nsl
83 id=nom_opt(1,nrbykin+nr)
84 CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1,nrbykin+nr),ltitr)
85C---------------------------------
86C CORRECTION DE LA MASSE ET DU
87C CENTRE DE GRAVITE DU MAIN
88C---------------------------------
89C-----CDG DES NOEUDS SECONDS
90 masrb=zero
91 xg(1)=zero
92 xg(2)= zero
93 xg(3) = zero
94 DO i=1,9
95 rby(i) = zero
96 ENDDO
97 DO i=1,nsl
98 n=lsn(i + kk)
99 lcrbm(i + kk ) = n
100 DO j=1,3
101 xg(j) = xg(j) + x(j,n)*ms(n)
102 ENDDO
103 masrb = masrb + ms(n)
104 ENDDO
105
106C
107 IF(masrb<=em30) THEN
108c CALL ANSTCKI(RBYID)
109 CALL ancmsg(msgid=679,
110 . msgtype=msgerror,
111 . anmode=aninfo_blind_1,
112 . i1=id,
113 . c1=titr,
114 . c2='ON SECONDARY NODES')
115 RETURN
116 ENDIF
117C
118 rbym(1,nr) = masrb
119 DO j=1,3
120 xg(j)=xg(j)/masrb
121 rbym(1 + j,nr) = xg(j)
122 ENDDO
123C--------------------------------------
124C L'INERTIE DU MAIN
125C--------------------------------------
126 DO i=1,nsl
127 n=lsn(i + kk)
128 xx=(x(1,n) - xg(1))*(x(1,n) - xg(1))
129 xy=(x(1,n) - xg(1))*(x(2,n) - xg(2))
130 xz=(x(1,n) - xg(1))*(x(3,n) - xg(3))
131 yy=(x(2,n) - xg(2))*(x(2,n) - xg(2))
132 yz=(x(2,n) - xg(2))*(x(3,n) - xg(3))
133 zz=(x(3,n) - xg(3))*(x(3,n) - xg(3))
134 rby(1) = rby(1) + in(n)+(yy+zz)*ms(n)
135 rby(2) = rby(2) - xy*ms(n)
136 rby(3) = rby(3) - xz*ms(n)
137 rby(4) = rby(4) - xy*ms(n)
138 rby(5) = rby(5) + in(n)+(zz+xx)*ms(n)
139 rby(6) = rby(6) - yz*ms(n)
140 rby(7) = rby(7) - xz*ms(n)
141 rby(8) = rby(8) - yz*ms(n)
142 rby(9) = rby(9) + in(n)+(xx+yy)*ms(n)
143 ENDDO
144C
145C Rigidite au noeud main pour estimation DT.
146C
147 DO i=1,nsl
148 n = lsn(i + kk)
149 rbym(27,nr)= rbym(27,nr) + stifn(i + kk)
150 dd = (x(1,n)-xg(1))**2 + (x(2,n)-xg(2))**2 + (x(3,n)-xg(3))**2
151 rbym(28,nr) = rbym(28,nr) + (stifr(i + kk) + dd*stifn(i + kk))
152 END DO
153C----------------------------------------------------------------
154C CALCUL DU REPERE D'INERTIE PRINCIPALE
155C----------------------------------------------------------------
156 CALL inepri(rby(10),rby)
157c IF(ISPH == 1)THEN
158c XIIN = (RBY(10) + RBY(11) + RBY(12)) * THIRD
159c RBY(10) = XIIN
160c RBY(11) = XIIN
161c RBY(12) = XIIN
162 WRITE(iout,1100) nr,nsl,xg(1),xg(2),xg(3),
163 . masrb
164 write(iout, 1300)
165 write(iout,1400) (lcrbm(i + kk ), i=1,nsl)
166c ELSE
167 inmin = min(rby(10),rby(11),rby(12))
168c ENDIF
169cc WRITE(IOUT,1400) RBY(10),RBY(11),RBY(12)
170 IF(rby(10)>=rby(11).AND.rby(10)>=rby(12))THEN
171 IF(rby(10)>(rby(11)+rby(12))*tol)THEN
172 CALL ancmsg(msgid=542,
173 . msgtype=msgwarning,
174 . anmode=aninfo_blind_1,
175 . i1=id,
176 . c1=titr,
177 . r1=rby(10),
178 . r2=rby(11),
179 . r3=rby(12))
180 ENDIF
181 ELSEIF(rby(11)>=rby(10).AND.rby(11)>=rby(12))THEN
182 IF(rby(11)>(rby(10)+rby(12))*tol)THEN
183 CALL ancmsg(msgid=542,
184 . msgtype=msgwarning,
185 . anmode=aninfo_blind_1,
186 . i1=id,
187 . c1=titr,
188 . r1=rby(11),
189 . r2=rby(10),
190 . r3=rby(12))
191 ENDIF
192 ELSEIF(rby(12)>=rby(10).AND.rby(12)>=rby(11))THEN
193 IF(rby(12)>(rby(10)+rby(11))*tol)THEN
194 CALL ancmsg(msgid=542,
195 . msgtype=msgwarning,
196 . anmode=aninfo_blind_1,
197 . i1=id,
198 . c1=titr,
199 . r1=rby(12),
200 . r2=rby(10),
201 . r3=rby(11))
202 ENDIF
203 ENDIF
204 IF(inmin<=0.0)THEN
205C CALL ANSTCKI(RBYID)
206 CALL ancmsg(msgid=274,
207 . msgtype=msgerror,
208 . anmode=aninfo_blind_1,
209 . i1=id,
210 . c1=titr)
211 ELSEIF(inmin<=1.e-10*max(rby(10),rby(11),rby(12)))THEN
212c CALL ANSTCKI(RBYID)
213 CALL ancmsg(msgid=275,
214 . msgtype=msgwarning,
215 . anmode=aninfo_blind_1,
216 . i1=id,
217 . c1=titr)
218 ENDIF
219C
220
221 rbym(5,nr) = rby(1)
222 rbym(6,nr) = rby(2)
223 rbym(7,nr) = rby(3)
224 rbym(8,nr) = rby(4)
225 rbym(9,nr) = rby(5)
226 rbym(10,nr) = rby(6)
227 rbym(11,nr) = rby(7)
228 rbym(12,nr) = rby(8)
229 rbym(13,nr) = rby(9)
230 rbym(14,nr) = rby(10)
231 rbym(15,nr) = rby(11)
232 rbym(16,nr) = rby(12)
233 rbym(17,nr) = min(rby(10),rby(11),rby(12))
234C
235
236C MATRICE d'inertie -> repere global
237 ii1=rby(10)*rby(1)
238 ii2=rby(10)*rby(2)
239 ii3=rby(10)*rby(3)
240 ii4=rby(11)*rby(4)
241 ii5=rby(11)*rby(5)
242 ii6=rby(11)*rby(6)
243 ii7=rby(12)*rby(7)
244 ii8=rby(12)*rby(8)
245 ii9=rby(12)*rby(9)
246C
247 rbym(18,nr)=rby(1)*ii1 + rby(4)*ii4 + rby(7)*ii7
248 rbym(19,nr)=rby(1)*ii2 + rby(4)*ii5 + rby(7)*ii8
249 rbym(20,nr)=rby(1)*ii3 + rby(4)*ii6 + rby(7)*ii9
250 rbym(21,nr)=rby(2)*ii1 + rby(5)*ii4 + rby(8)*ii7
251 rbym(22,nr)=rby(2)*ii2 + rby(5)*ii5 + rby(8)*ii8
252 rbym(23,nr)=rby(2)*ii3 + rby(5)*ii6 + rby(8)*ii9
253 rbym(24,nr)=rby(3)*ii1 + rby(6)*ii4 + rby(9)*ii7
254 rbym(25,nr)=rby(3)*ii2 + rby(6)*ii5 + rby(9)*ii8
255 rbym(26,nr)=rby(3)*ii3 + rby(6)*ii6 + rby(9)*ii9
256 kk = kk + nsl
257 ENDDO
258C
259 RETURN
260C
2611000 FORMAT(//
262 . ' RIGID BODY INITIALIZATION '/
263 . ' ------------------------- ')
2641100 FORMAT(/5x,'RIGID BODY ID',i10
265 . /5x,'NUMBER OF SECONDARY NODE' ,i10
266 . /10x,'NEW X,Y,Z ',3g14.7
267 . /10x,'NEW MASS ',1g14.7)
268c . /10X,'NEW INERTIA xx yy zz ',3G14.7
269c . /10X,'NEW INERTIA xy yz zx ',3G14.7)
2701200 FORMAT(10x,'PRINCIPAL INERTIE ',1p3g14.7)
2711300 FORMAT(10x,'SECONDARY NODES ')
2721400 FORMAT(10x,10i10)
273 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
rigid_mat
subroutine rigid_mat(nrb, gnsl, lsn, nslnrm, stifn, stifr, x, v, ms, in, rbym, irbym, lcrbm, nom_opt)
Definition rigid_mat.F:37
inepri
subroutine inepri(xi, bm)
Definition inepri.F:34
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
starter
program starter
Definition starter.F:39