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 IF(.NOT.is_available) oflag = oflag + 1
129 CALL hm_get_intv('Cty_Fun',ifun_cyy,is_available,lsubmodel)
130 IF(.NOT.is_available) oflag = oflag + 1
131 CALL hm_get_intv('Ctz_Fun',ifun_czz,is_available,lsubmodel)
132 IF(.NOT.is_available) oflag = oflag + 1
133 CALL hm_get_intv('Crx_Fun',ifun_crx,is_available,lsubmodel)
134 IF(.NOT.is_available) oflag = oflag + 1
135 CALL hm_get_intv('Cry_Fun',ifun_cry,is_available,lsubmodel)
136 IF(.NOT.is_available) oflag = oflag + 1
137 CALL hm_get_intv('Crz_Fun',ifun_crz,is_available,lsubmodel)
138 IF(.NOT.is_available) oflag = oflag + 1
139C--------------------------------------------------
140C EXTRACT DATAS (REAL VALUES)
141C--------------------------------------------------
142 CALL hm_get_floatv('Ctx',cxx,is_available,lsubmodel,unitab)
143 IF(.NOT.is_available) oflag = oflag + 1
144 CALL hm_get_floatv('Cty',cyy,is_available,lsubmodel,unitab)
145 IF(.NOT.is_available) oflag = oflag + 1
146 CALL hm_get_floatv('Ctz',czz,is_available,lsubmodel,unitab)
147 IF(.NOT.is_available) oflag = oflag + 1
148 CALL hm_get_floatv('Crx',crx,is_available,lsubmodel,unitab)
149 IF(.NOT.is_available) oflag = oflag + 1
150 CALL hm_get_floatv('Cry',cry,is_available,lsubmodel,unitab)
151 IF(.NOT.is_available) oflag = oflag + 1
152 CALL hm_get_floatv('Crz',crz,is_available,lsubmodel,unitab)
153 IF(.NOT.is_available) oflag = oflag + 1
154C-----------------------
155 IF (idsk1<=0.OR.idsk2<=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 IF(cxx==zero.AND.ifun_cxx/=0)cxx = one
172 IF(cyy==zero.AND.ifun_cyy/=0)cyy = one
173 IF(czz==zero.AND.ifun_czz/=0)czz = one
174 IF(crx==zero.AND.ifun_crx/=0)crx = one
175 IF(cry==zero.AND.ifun_cry/=0)cry = one
176 IF(crz==zero.AND.ifun_crz/=0)crz = one
177C
178 IF(kxx==zero.AND.ifun_xx/=0) kxx = one
179 IF(kyy==zero.AND.ifun_yy/=0) kyy = one
180 IF(kzz==zero.AND.ifun_zz/=0) kzz = one
181 IF(krx==zero.AND.ifun_rx/=0) krx = one
182 IF(kry==zero.AND.ifun_ry/=0) kry = one
183 IF(krz==zero.AND.ifun_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
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
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
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:895
submodel_mod::submodel_data
Definition submodel_mod.F:728