OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop33_free_jnt.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!|| hm_read_prop33_free_jnt ../starter/source/properties/spring/hm_read_prop33_free_jnt.f
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop33 ../starter/source/properties/spring/hm_read_prop33.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.f
31!|| set_u_geo ../starter/source/user_interface/uaccess.F
32!|| set_u_pnu ../starter/source/user_interface/uaccess.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.f
36!||====================================================================
37 SUBROUTINE hm_read_prop33_free_jnt(IOUT, ITYP, SKFLAG, PARGEO,IS_ENCRYPTED,
38 . UNITAB,IUNIT,ID,TITR,LSUBMODEL)
39 USE unitab_mod
40 USE message_mod
41 USE submodel_mod
42 USE names_and_titles_mod , ONLY : nchartitle
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C A n a l y s e M o d u l e
49C-----------------------------------------------
50C----------+---------+---+---+--------------------------------------------
51C VAR | SIZE |TYP| RW| DEFINITION
52C----------+---------+---+---+--------------------------------------------
53C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
54C----------+---------+---+---+--------------------------------------------
55C PARGEO | * | F | W | 1)SKEW NUMBER
56C | | | | 2)STIFNESS FOR INTERFACE
57C | | | | 3)FRONT WAVE OPTION
58C | | | | 4)... not yet used
59C----------+---------+---+---+------------------------------------------|
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
63 INTEGER IOUT, ITYP, SKFLAG,IUNIT
64 my_real pargeo(*)
65
66 INTEGER ID
67 CHARACTER(LEN=NCHARTITLE) :: TITR
68 LOGICAL IS_ENCRYPTED
69 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
70C=======================================================================
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER IERROR,IDSK1,IDSK2,IFUN_XX,IFUN_YY,IFUN_ZZ,
74 . ifun_rx,ifun_ry,ifun_rz,ifun_cxx,ifun_cyy,ifun_czz,
75 . ifun_crx,ifun_cry,ifun_crz,oflag
76 my_real xk,xtyp,xflg,xsk1,xsk2,mass,iner,
77 . cr,kxx,kyy,kzz,krx,kry,krz,cxx,cyy,czz,crx,cry,crz,
78 . fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,fac_ctx,fac_crx,
79 . fac_ff,fac_mm
80C-----------------------------------------------
81 INTEGER SET_U_PNU,SET_U_GEO,KFUNC
82 parameter(kfunc=29)
83 LOGICAL IS_AVAILABLE
84 EXTERNAL set_u_pnu,set_u_geo
85C=======================================================================
86C---- FREE SPRING JOINT
87C=======================================================================
88 fac_m = unitab%FAC_M(iunit)
89 fac_l = unitab%FAC_L(iunit)
90 fac_t = unitab%FAC_T(iunit)
91 fac_ff = fac_m / fac_t
92 fac_mm = one / fac_t
93 fac_ct = fac_m / fac_t
94 fac_cr = fac_m * fac_l**2 / fac_t
95 fac_kt = fac_ct / fac_t
96 fac_kr = fac_cr / fac_t
97 fac_ctx = fac_t / fac_l
98 fac_crx = fac_t
99 oflag = 0
100C
101C--------------------------------------------------
102C EXTRACT DATAS (INTEGER VALUES)
103C--------------------------------------------------
104 CALL hm_get_intv('Idsk1',idsk1,is_available,lsubmodel)
105 CALL hm_get_intv('Idsk2',idsk2,is_available,lsubmodel)
106 CALL hm_get_intv('Xt_fun',ifun_xx,is_available,lsubmodel)
107 CALL hm_get_intv('yt_fun',IFUN_YY,IS_AVAILABLE,LSUBMODEL)
108 CALL HM_GET_INTV('zt_fun',IFUN_ZZ,IS_AVAILABLE,LSUBMODEL)
109 CALL HM_GET_INTV('xr_fun',IFUN_RX,IS_AVAILABLE,LSUBMODEL)
110 CALL HM_GET_INTV('yr_fun',IFUN_RY,IS_AVAILABLE,LSUBMODEL)
111 CALL HM_GET_INTV('zr_fun',IFUN_RZ,IS_AVAILABLE,LSUBMODEL)
112C--------------------------------------------------
113C EXTRACT DATAS (REAL VALUES)
114C--------------------------------------------------
115 CALL HM_GET_FLOATV('xk',XK,IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV('cr',CR,IS_AVAILABLE,LSUBMODEL,UNITAB)
117 CALL HM_GET_FLOATV('ktx',KXX,IS_AVAILABLE,LSUBMODEL,UNITAB)
118 CALL HM_GET_FLOATV('kty',KYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
119 CALL HM_GET_FLOATV('ktz',KZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
120 CALL HM_GET_FLOATV('krx',KRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
121 CALL HM_GET_FLOATV('kry',KRY,IS_AVAILABLE,LSUBMODEL,UNITAB)
122 CALL HM_GET_FLOATV('krz',KRZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
123C--- viscosity
124C--------------------------------------------------
125C EXTRACT DATAS (INTEGER VALUES)
126C--------------------------------------------------
127 CALL HM_GET_INTV('ctx_fun',IFUN_CXX,IS_AVAILABLE,LSUBMODEL)
128.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
129 CALL HM_GET_INTV('cty_fun',IFUN_CYY,IS_AVAILABLE,LSUBMODEL)
130.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
131 CALL HM_GET_INTV('ctz_fun',IFUN_CZZ,IS_AVAILABLE,LSUBMODEL)
132.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
133 CALL HM_GET_INTV('crx_fun',IFUN_CRX,IS_AVAILABLE,LSUBMODEL)
134.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
135 CALL HM_GET_INTV('cry_fun',IFUN_CRY,IS_AVAILABLE,LSUBMODEL)
136.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
137 CALL HM_GET_INTV('crz_fun',IFUN_CRZ,IS_AVAILABLE,LSUBMODEL)
138.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
139C--------------------------------------------------
140C EXTRACT DATAS (REAL VALUES)
141C--------------------------------------------------
142 CALL HM_GET_FLOATV('ctx',CXX,IS_AVAILABLE,LSUBMODEL,UNITAB)
143.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
144 CALL HM_GET_FLOATV('cty',CYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
145.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
146 CALL HM_GET_FLOATV('ctz',CZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
147.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
148 CALL HM_GET_FLOATV('crx',CRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
149.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
150 CALL HM_GET_FLOATV('cry',CRY,IS_AVAILABLE,LSUBMODEL,UNITAB)
151.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
152 CALL HM_GET_FLOATV('crz',CRZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
153.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
154C-----------------------
155.OR. IF (IDSK1<=0IDSK2<=0) THEN
156 CALL ANCMSG(MSGID=386,
157 . MSGTYPE=MSGERROR,
158 . ANMODE=ANINFO_BLIND_1,
159 . I1=ID,
160 . C1=TITR)
161 ENDIF
162C
163 CR = ZERO
164 XTYP = ITYP
165 XFLG = SKFLAG
166 XSK1 = IDSK1
167 XSK2 = IDSK2
168 MASS = ZERO
169 INER = ZERO
170C
171.AND. IF(CXX==ZEROIFUN_CXX/=0)CXX = ONE
172.AND. IF(CYY==ZEROIFUN_CYY/=0)CYY = ONE
173.AND. IF(CZZ==ZEROIFUN_CZZ/=0)CZZ = ONE
174.AND. IF(CRX==ZEROIFUN_CRX/=0)CRX = ONE
175.AND. IF(CRY==ZEROIFUN_CRY/=0)CRY = ONE
176.AND. IF(CRZ==ZEROIFUN_CRZ/=0)CRZ = ONE
177C
178.AND. IF(KXX==ZEROIFUN_XX/=0) KXX = ONE
179.AND. IF(KYY==ZEROIFUN_YY/=0) KYY = ONE
180.AND. IF(KZZ==ZEROIFUN_ZZ/=0) KZZ = ONE
181.AND. IF(KRX==ZEROIFUN_RX/=0) KRX = ONE
182.AND. IF(KRY==ZEROIFUN_RY/=0) KRY = ONE
183.AND. IF(KRZ==ZEROIFUN_RZ/=0) KRZ = ONE
184C-----------------------
185 IF (IFUN_XX /= 0) KXX = KXX * FAC_FF
186 IF (IFUN_YY /= 0) KYY = KYY * FAC_FF
187 IF (IFUN_ZZ /= 0) KZZ = KZZ * FAC_FF
188 IF (IFUN_RX /= 0) KRX = KRX * FAC_MM
189 IF (IFUN_RY /= 0) KRY = KRY * FAC_MM
190 IF (IFUN_RZ /= 0) KRZ = KRZ * FAC_MM
191 IF (IFUN_CXX /= 0) CXX = CXX * FAC_FF
192 IF (IFUN_CYY /= 0) CYY = CYY * FAC_FF
193 IF (IFUN_CZZ /= 0) CZZ = CZZ * FAC_FF
194 IF (IFUN_CRX /= 0) CRX = CRX * FAC_MM
195 IF (IFUN_CRY /= 0) CRY = CRY * FAC_MM
196 IF (IFUN_CRZ /= 0) CRZ = CRZ * FAC_MM
197C-----------------------
198 PARGEO(1) = 0
199 PARGEO(2) = XK
200 PARGEO(3) = 0
201C---------------------
202 IERROR = SET_U_GEO(1,XTYP)
203 IERROR = SET_U_GEO(2,XSK1)
204 IERROR = SET_U_GEO(3,XSK2)
205 IERROR = SET_U_GEO(4,KXX)
206 IERROR = SET_U_GEO(5,KYY)
207 IERROR = SET_U_GEO(6,KZZ)
208 IERROR = SET_U_GEO(7,KRX)
209 IERROR = SET_U_GEO(8,KRY)
210 IERROR = SET_U_GEO(9,KRZ)
211 IERROR = SET_U_GEO(10,ZERO)
212 IERROR = SET_U_GEO(11,ZERO)
213 IERROR = SET_U_GEO(12,MASS)
214 IERROR = SET_U_GEO(13,INER)
215 IERROR = SET_U_GEO(14,XFLG)
216 IERROR = SET_U_GEO(15,ZERO)
217 IERROR = SET_U_GEO(16,ZERO)
218 IERROR = SET_U_GEO(17,ZERO)
219 IERROR = SET_U_GEO(18,ZERO)
220 IERROR = SET_U_GEO(19,ZERO)
221 IERROR = SET_U_GEO(20,ZERO)
222 IERROR = SET_U_GEO(21,CXX)
223 IERROR = SET_U_GEO(22,CYY)
224 IERROR = SET_U_GEO(23,CZZ)
225 IERROR = SET_U_GEO(24,CRX)
226 IERROR = SET_U_GEO(25,CRY)
227 IERROR = SET_U_GEO(26,CRZ)
228 IERROR = SET_U_GEO(27,FAC_CTX)
229 IERROR = SET_U_GEO(28,FAC_CRX)
230 IERROR = SET_U_PNU(1,IFUN_XX,KFUNC)
231 IERROR = SET_U_PNU(2,IFUN_YY,KFUNC)
232 IERROR = SET_U_PNU(3,IFUN_ZZ,KFUNC)
233 IERROR = SET_U_PNU(4,IFUN_RX,KFUNC)
234 IERROR = SET_U_PNU(5,IFUN_RY,KFUNC)
235 IERROR = SET_U_PNU(6,IFUN_RZ,KFUNC)
236 IERROR = SET_U_PNU(7,IFUN_CXX,KFUNC)
237 IERROR = SET_U_PNU(8,IFUN_CYY,KFUNC)
238 IERROR = SET_U_PNU(9,IFUN_CZZ,KFUNC)
239 IERROR = SET_U_PNU(10,IFUN_CRX,KFUNC)
240 IERROR = SET_U_PNU(11,IFUN_CRY,KFUNC)
241 IERROR = SET_U_PNU(12,IFUN_CRZ,KFUNC)
242C-----------------------
243 WRITE(IOUT,500)
244 IF(IS_ENCRYPTED)THEN
245 WRITE(IOUT,'(5x,a,//)')'confidential data'
246 ELSE
247 IF (OFLAG==12) THEN
248 WRITE(IOUT,1001)IDSK1,IDSK2,XK,CR,KXX,KYY,KZZ,
249 . KRX,KRY,KRZ,IFUN_XX,IFUN_YY,IFUN_ZZ,
250 . IFUN_RX,IFUN_RY,IFUN_RZ
251 ELSE
252 WRITE(IOUT,1000)IDSK1,IDSK2,XK,CR,KXX,KYY,KZZ,
253 . KRX,KRY,KRZ,IFUN_XX,IFUN_YY,IFUN_ZZ,
254 . IFUN_RX,IFUN_RY,IFUN_RZ,
255 . CXX,CYY,CZZ,CRX,CRY,CRZ,
256 . IFUN_CXX,IFUN_CYY,IFUN_CZZ,
257 . IFUN_CRX,IFUN_CRY,IFUN_CRZ
258 ENDIF
259 ENDIF
260C-----------------------
261 RETURN
262 500 FORMAT(
263 & 5X,'joint TYPE . . . . . . . . . . free spring joint'//)
264 1000 FORMAT(
265 & 5X,'skew 1 frame id. . . . . . . . . . . . =',I10/,
266 & 5X,'skew 2 frame id. . . . . . . . . . . . =',I10/,
267 & 5X,'stiffness for INTERFACE k=e*a/l. . . . =',1PG20.13/,
268 & 5X,'critical damping coefficient . . . . . =',1PG20.13/,
269 & 5X,'linear translational stiffness kxx . . =',1PG20.13/,
270 & 5X,'linear translational stiffness kyy . . =',1PG20.13/,
271 & 5X,'linear translational stiffness kzz . . =',1PG20.13/,
272 & 5X,'linear torsional stiffness krx . . . . =',1PG20.13/,
273 & 5X,'linear torsional stiffness kry . . . . =',1PG20.13/,
274 & 5X,'linear torsional stiffness krz . . . . =',1PG20.13/,
275 & 5X,'user x translation function. . . . . . =',I10/,
276 & 5X,'user y translation function. . . . . . =',I10/,
277 & 5X,'user z translation function. . . . . . =',I10/,
278 & 5X,'user rx torsion FUNCTION id. . . . . . =',I10/,
279 & 5X,'user ry torsion function id. . . . . . =',I10/,
280 & 5X,'user rz torsion function id. . . . . . =',I10/,
281 & 5X,'linear damping cxx . . . . . . . . . . =',1PG20.13/,
282 & 5X,'linear damping cyy . . . . . . . . . . =',1PG20.13/,
283 & 5X,'linear damping czz . . . . . . . . . . =',1PG20.13/,
284 & 5X,'linear damping crx . . . . . . . . . . =',1PG20.13/,
285 & 5X,'linear damping cry . . . . . . . . . . =',1PG20.13/,
286 & 5X,'linear damping crz . . . . . . . . . . =',1PG20.13/,
287 & 5X,'user xx damping function . . . . . . . =',I10/,
288 & 5X,'user yy damping function . . . . . . . =',i10/,
289 & 5x,'USER ZZ DAMPING FUNCTION . . . . . . . =',i10/,
290 & 5x,'USER RX DAMPING FUNCTION . . . . . . . =',i10/,
291 & 5x,'USER RY DAMPING FUNCTION . . . . . . . =',i10/,
292 & 5x,'USER RZ DAMPING FUNCTION . . . . . . . =',i10//)
293 1001 FORMAT(
294 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
295 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
296 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
297 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
298 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KXX . . =',1pg20.13/,
299 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KYY . . =',1pg20.13/,
300 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KZZ . . =',1pg20.13/,
301 & 5x,'LINEAR TORSIONAL STIFFNESS KRX . . . . =',1pg20.13/,
302 & 5x,'LINEAR TORSIONAL STIFFNESS KRY . . . . =',1pg20.13/,
303 & 5x,'LINEAR TORSIONAL STIFFNESS KRZ . . . . =',1pg20.13/,
304 & 5x,'USER X TRANSLATION FUNCTION. . . . . . =',i10/,
305 & 5x,'USER Y TRANSLATION FUNCTION. . . . . . =',i10/,
306 & 5x,'USER Z TRANSLATION FUNCTION. . . . . . =',i10/,
307 & 5x,'USER RX TORSION FUNCTION ID. . . . . . =',i10/,
308 & 5x,'USER RY TORSION FUNCTION ID. . . . . . =',i10/,
309 & 5x,'USER RZ TORSION FUNCTION ID. . . . . . =',i10//)
310C-----------------------
311 RETURN
312 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_read_prop33_free_jnt
subroutine hm_read_prop33_free_jnt(iout, ityp, skflag, pargeo, is_encrypted, unitab, iunit, id, titr, lsubmodel)
Definition hm_read_prop33_free_jnt.F:39
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723