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.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
120 CALL HM_GET_INTV('crz_fun',IFUN_CRZ,IS_AVAILABLE,LSUBMODEL)
121.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
122C--------------------------------------------------
123C EXTRACT DATAS (REAL VALUES)
124C--------------------------------------------------
125 CALL HM_GET_FLOATV('cry',CRY,IS_AVAILABLE,LSUBMODEL,UNITAB)
126.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
127 CALL HM_GET_FLOATV('crz',CRZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
128.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
129C-----------------------
130.OR. IF (IDSK1<=0IDSK2<=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.OR. IF (CR<ZEROCR>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.AND. IF(CRY==ZEROIFUN_CRY/=0)CRY = ONE
161.AND. IF(CRZ==ZEROIFUN_CRZ/=0)CRZ = ONE
162.AND. IF(KRY==ZEROIFUN_RY/=0) KRY = ONE
163.AND. IF(KRZ==ZEROIFUN_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
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_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_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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
submodel_mod::submodel_data
Definition submodel_mod.F:728