OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop33_univ_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_univ_jnt ../starter/source/properties/spring/hm_read_prop33_univ_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_univ_jnt(IOUT, ITYP, 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,IUNIT
64 my_real pargeo(*)
65 INTEGER ID
66 CHARACTER(LEN=NCHARTITLE) :: TITR
67 LOGICAL IS_ENCRYPTED
68 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
69C=======================================================================
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER IERROR,IDSK1,IDSK2,IFUN_RY,IFUN_RZ,IFUN_CRY,IFUN_CRZ,
73 . zeroi,oflag
74 my_real
75 . xk,xtyp,xflg,xsk1,xsk2,knn,kry,krz,cr,cry,crz,mass,iner,
76 . fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,fac_ctx,fac_crx,
77 . fac_mm
78C-----------------------------------------------
79 INTEGER SET_U_PNU,SET_U_GEO,KFUNC
80 EXTERNAL set_u_pnu,set_u_geo
81 parameter(kfunc=29)
82 DATA zeroi/0/
83 LOGICAL IS_AVAILABLE
84C=======================================================================
85C---- UNIVERSAL JOINT
86C=======================================================================
87 fac_m = unitab%FAC_M(iunit)
88 fac_l = unitab%FAC_L(iunit)
89 fac_t = unitab%FAC_T(iunit)
90 fac_mm = one / fac_t
91 fac_ct = fac_m / fac_t
92 fac_cr = fac_m * fac_l**2 / fac_t
93 fac_kt = fac_ct / fac_t
94 fac_kr = fac_cr / fac_t
95 fac_ctx = fac_t / fac_l
96 fac_crx = fac_t
97 oflag = 0
98C
99C--------------------------------------------------
100C EXTRACT DATAS (INTEGER VALUES)
101C--------------------------------------------------
102 CALL hm_get_intv('Idsk1',idsk1,is_available,lsubmodel)
103 CALL hm_get_intv('Idsk2',idsk2,is_available,lsubmodel)
104 CALL hm_get_intv('Yr_fun',ifun_ry,is_available,lsubmodel)
105 CALL hm_get_intv('Zr_fun',ifun_rz,is_available,lsubmodel)
106C--------------------------------------------------
107C EXTRACT DATAS (REAL VALUES)
108C--------------------------------------------------
109 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
110 CALL hm_get_floatv('Cr',cr,is_available,lsubmodel,unitab)
111 CALL hm_get_floatv('Kn',knn,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv('Kry',kry,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('Krz',krz,is_available,lsubmodel,unitab)
114C--- viscosity
115C--------------------------------------------------
116C EXTRACT DATAS (INTEGER VALUES)
117C--------------------------------------------------
118 CALL hm_get_intv('Cry_Fun',ifun_cry,is_available,lsubmodel)
119 IF(.NOT.is_available) oflag = oflag + 1
120 CALL hm_get_intv('Crz_Fun',ifun_crz,is_available,lsubmodel)
121 IF(.NOT.is_available) oflag = oflag + 1
122C--------------------------------------------------
123C EXTRACT DATAS (REAL VALUES)
124C--------------------------------------------------
125 CALL hm_get_floatv('Cry',cry,is_available,lsubmodel,unitab)
126 IF(.NOT.is_available) oflag = oflag + 1
127 CALL hm_get_floatv('Crz',crz,is_available,lsubmodel,unitab)
128 IF(.NOT.is_available) oflag = oflag + 1
129C-----------------------
130 IF (idsk1<=0.OR.idsk2<=0.) THEN
131 CALL ancmsg(msgid=386,
132 . msgtype=msgerror,
133 . anmode=aninfo_blind_1,
134 . i1=id,
135 . c1=titr)
136 ENDIF
137 IF (knn==0.) THEN
138 CALL ancmsg(msgid=387,
139 . msgtype=msgerror,
140 . anmode=aninfo_blind_1,
141 . i1=id,
142 . c1=titr)
143 ENDIF
144 IF (cr<zero.OR.cr>1.) THEN
145 CALL ancmsg(msgid=388,
146 . msgtype=msgerror,
147 . anmode=aninfo_blind_1,
148 . i1=id,
149 . c1=titr)
150 ENDIF
151 IF (cr==zero) cr = fiveem2
152C
153 xtyp = ityp
154 xflg = zero
155 xsk1 = idsk1
156 xsk2 = idsk2
157 mass = zero
158 iner = zero
159C
160 IF(cry==zero.AND.ifun_cry/=0)cry = one
161 IF(crz==zero.AND.ifun_crz/=0)crz = one
162 IF(kry==zero.AND.ifun_ry/=0) kry = one
163 IF(krz==zero.AND.ifun_rz/=0) krz = one
164C-----------------------
165 IF (ifun_ry /= 0) kry = kry * fac_mm
166 IF (ifun_rz /= 0) krz = krz * fac_mm
167 IF (ifun_cry /= 0) cry = cry * fac_mm
168 IF (ifun_crz /= 0) crz = crz * fac_mm
169C-----------------------
170 pargeo(1) = 0
171 pargeo(2) = xk
172 pargeo(3) = 0
173C-----------------------
174 ierror = set_u_geo(1,xtyp)
175 ierror = set_u_geo(2,xsk1)
176 ierror = set_u_geo(3,xsk2)
177 ierror = set_u_geo(4,knn)
178 ierror = set_u_geo(5,knn)
179 ierror = set_u_geo(6,knn)
180 ierror = set_u_geo(7,knn)
181 ierror = set_u_geo(8,kry)
182 ierror = set_u_geo(9,krz)
183 ierror = set_u_geo(10,knn)
184 ierror = set_u_geo(11,zero)
185 ierror = set_u_geo(12,mass)
186 ierror = set_u_geo(13,iner)
187 ierror = set_u_geo(14,xflg)
188 ierror = set_u_geo(15,cr)
189 ierror = set_u_geo(16,cr)
190 ierror = set_u_geo(17,cr)
191 ierror = set_u_geo(18,cr)
192 ierror = set_u_geo(19,zero)
193 ierror = set_u_geo(20,zero)
194 ierror = set_u_geo(21,zero)
195 ierror = set_u_geo(22,zero)
196 ierror = set_u_geo(23,zero)
197 ierror = set_u_geo(24,zero)
198 ierror = set_u_geo(25,cry)
199 ierror = set_u_geo(26,crz)
200 ierror = set_u_geo(27,fac_ctx)
201 ierror = set_u_geo(28,fac_crx)
202 ierror = set_u_pnu(1,zeroi,kfunc)
203 ierror = set_u_pnu(2,zeroi,kfunc)
204 ierror = set_u_pnu(3,zeroi,kfunc)
205 ierror = set_u_pnu(4,zeroi,kfunc)
206 ierror = set_u_pnu(5,ifun_ry,kfunc)
207 ierror = set_u_pnu(6,ifun_rz,kfunc)
208 ierror = set_u_pnu(7,zeroi,kfunc)
209 ierror = set_u_pnu(8,zeroi,kfunc)
210 ierror = set_u_pnu(9,zeroi,kfunc)
211 ierror = set_u_pnu(10,zeroi,kfunc)
212 ierror = set_u_pnu(11,ifun_cry,kfunc)
213 ierror = set_u_pnu(12,ifun_crz,kfunc)
214C-----------------------
215 WRITE(iout,500)
216 IF(is_encrypted)THEN
217 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
218 ELSE
219 IF (oflag==4) THEN
220 WRITE(iout,1001) idsk1,idsk2,xk,cr,knn,kry,krz,
221 . ifun_ry,ifun_rz
222 ELSE
223 WRITE(iout,1000) idsk1,idsk2,xk,cr,knn,kry,krz,
224 . ifun_ry,ifun_rz,cry,crz,ifun_cry,ifun_crz
225 ENDIF
226 ENDIF
227C-----------------------
228 RETURN
229C-----------------------
230 500 FORMAT(
231 & 5x,'JOINT TYPE . . . . . . . . UNIVERSAL JOINT'//)
232 1000 FORMAT(
233 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
234 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
235 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
236 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
237 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
238 & 5x,'LINEAR ROTATIONAL STIFFNESS KYY. . . . =',1pg20.13/,
239 & 5x,'LINEAR ROTATIONAL STIFFNESS KZZ. . . . =',1pg20.13/,
240 & 5x,'USER RY TORSION FUNCTION ID. . . . . . =',i10/,
241 & 5x,'USER RZ TORSION FUNCTION ID. . . . . . =',i10/,
242 & 5x,'LINEAR DAMPING CRY . . . . . . . . . . =',1pg20.13/,
243 & 5x,'LINEAR DAMPING CRZ . . . . . . . . . . =',1pg20.13/,
244 & 5x,'USER RY DAMPING FUNCTION . . . . . . . =',i10/,
245 & 5x,'USER RZ DAMPING FUNCTION . . . . . . . =',i10//)
246 1001 FORMAT(
247 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
248 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
249 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
250 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
251 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
252 & 5x,'LINEAR ROTATIONAL STIFFNESS KYY. . . . =',1pg20.13/,
253 & 5x,'LINEAR ROTATIONAL STIFFNESS KZZ. . . . =',1pg20.13/,
254 & 5x,'USER RY TORSION FUNCTION ID. . . . . . =',i10/,
255 & 5x,'USER RZ TORSION FUNCTION ID. . . . . . =',i10//)
256 RETURN
257 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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_read_prop33_univ_jnt
subroutine hm_read_prop33_univ_jnt(iout, ityp, pargeo, is_encrypted, unitab, iunit, id, titr, lsubmodel)
Definition hm_read_prop33_univ_jnt.F:39
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
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
set_u_pnu
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723