OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop33_sph_jnt.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop33_sph_jnt (iout, ityp, skflag, pargeo, is_encrypted, unitab, iunit, id, titr, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_prop33_sph_jnt()

subroutine hm_read_prop33_sph_jnt ( integer iout,
integer ityp,
integer skflag,
pargeo,
logical is_encrypted,
type (unit_type_), intent(in) unitab,
integer iunit,
integer id,
character(len=nchartitle) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 37 of file hm_read_prop33_sph_jnt.F.

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_RX,IFUN_RY,IFUN_RZ,
74 . IFUN_CRX,IFUN_CRY,IFUN_CRZ, ZEROI,OFLAG
75 my_real
76 . xk,xtyp,xflg,xsk1,xsk2,knn,krx,kry,krz,cr,crx,cry,crz,
77 . mass,iner,fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,
78 . fac_ctx,fac_crx,fac_mm
79C-----------------------------------------------
80 INTEGER SET_U_PNU,SET_U_GEO,KFUNC
81 EXTERNAL set_u_pnu,set_u_geo
82 parameter(kfunc=29)
83 DATA zeroi/0/
84 LOGICAL IS_AVAILABLE
85C=======================================================================
86C---- SPHERICAL 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_mm = one / fac_t
92 fac_ct = fac_m / fac_t
93 fac_cr = fac_m * fac_l**2 / fac_t
94 fac_kt = fac_ct / fac_t
95 fac_kr = fac_cr / fac_t
96 fac_ctx = fac_t / fac_l
97 fac_crx = fac_t
98 oflag = 0
99C
100C--------------------------------------------------
101C EXTRACT DATAS (INTEGER VALUES)
102C--------------------------------------------------
103 CALL hm_get_intv('Idsk1',idsk1,is_available,lsubmodel)
104 CALL hm_get_intv('Idsk2',idsk2,is_available,lsubmodel)
105 CALL hm_get_intv('Xr_fun',ifun_rx,is_available,lsubmodel)
106 CALL hm_get_intv('Yr_fun',ifun_ry,is_available,lsubmodel)
107 CALL hm_get_intv('Zr_fun',ifun_rz,is_available,lsubmodel)
108C--------------------------------------------------
109C EXTRACT DATAS (REAL VALUES)
110C--------------------------------------------------
111 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv('Cr',cr,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('kn',KNN,IS_AVAILABLE,LSUBMODEL,UNITAB)
114 CALL HM_GET_FLOATV('krx',KRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
115 CALL HM_GET_FLOATV('kry',KRY,IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV('krz',KRZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
117C--- viscosity
118C--------------------------------------------------
119C EXTRACT DATAS (INTEGER VALUES)
120C--------------------------------------------------
121 CALL HM_GET_INTV('crx_fun',IFUN_CRX,IS_AVAILABLE,LSUBMODEL)
122.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
123 CALL HM_GET_INTV('cry_fun',IFUN_CRY,IS_AVAILABLE,LSUBMODEL)
124.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
125 CALL HM_GET_INTV('crz_fun',IFUN_CRZ,IS_AVAILABLE,LSUBMODEL)
126.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
127C--------------------------------------------------
128C EXTRACT DATAS (REAL VALUES)
129C--------------------------------------------------
130 CALL HM_GET_FLOATV('crx',CRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
131.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
132 CALL HM_GET_FLOATV('cry',CRY,IS_AVAILABLE,LSUBMODEL,UNITAB)
133.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
134 CALL HM_GET_FLOATV('crz',CRZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
135.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
136C-----------------------
137.OR. IF (IDSK1<=0IDSK1<=0) THEN
138 CALL ANCMSG(MSGID=386,
139 . MSGTYPE=MSGERROR,
140 . ANMODE=ANINFO_BLIND_1,
141 . I1=ID,
142 . C1=TITR)
143 ENDIF
144 IF (KNN==0.) THEN
145 CALL ANCMSG(MSGID=387,
146 . MSGTYPE=MSGERROR,
147 . ANMODE=ANINFO_BLIND_1,
148 . I1=ID,
149 . C1=TITR)
150 ENDIF
151.OR. IF (CR<ZEROCR>1.) THEN
152 CALL ANCMSG(MSGID=388,
153 . MSGTYPE=MSGERROR,
154 . ANMODE=ANINFO_BLIND_1,
155 . I1=ID,
156 . C1=TITR)
157 ENDIF
158 IF (CR==ZERO) CR = FIVEEM2
159C
160 XTYP = ITYP
161 XFLG = SKFLAG
162 XSK1 = IDSK1
163 XSK2 = IDSK2
164 MASS = ZERO
165 INER = ZERO
166C
167.AND. IF(CRX==ZEROIFUN_CRX/=0)CRX = ONE
168.AND. IF(CRY==ZEROIFUN_CRY/=0)CRY = ONE
169.AND. IF(CRZ==ZEROIFUN_CRZ/=0)CRZ = ONE
170.AND. IF(KRX==ZEROIFUN_RX/=0) KRX = ONE
171.AND. IF(KRY==ZEROIFUN_RY/=0) KRY = ONE
172.AND. IF(KRZ==ZEROIFUN_RZ/=0) KRZ = ONE
173C-----------------------
174 IF (IFUN_RX /= 0) KRX = KRX * FAC_MM
175 IF (IFUN_RY /= 0) KRY = KRY * FAC_MM
176 IF (IFUN_RZ /= 0) KRZ = KRZ * FAC_MM
177 IF (IFUN_CRX /= 0) CRX = CRX * FAC_MM
178 IF (IFUN_CRY /= 0) CRY = CRY * FAC_MM
179 IF (IFUN_CRZ /= 0) CRZ = CRZ * FAC_MM
180C-----------------------
181 PARGEO(1) = 0
182 PARGEO(2) = XK
183 PARGEO(3) = 0
184C-----------------------
185 IERROR = SET_U_GEO(1,XTYP)
186 IERROR = SET_U_GEO(2,XSK1)
187 IERROR = SET_U_GEO(3,XSK2)
188 IERROR = SET_U_GEO(4,KNN)
189 IERROR = SET_U_GEO(5,KNN)
190 IERROR = SET_U_GEO(6,KNN)
191 IERROR = SET_U_GEO(7,KRX)
192 IERROR = SET_U_GEO(8,KRY)
193 IERROR = SET_U_GEO(9,KRZ)
194 IERROR = SET_U_GEO(10,KNN)
195 IERROR = SET_U_GEO(11,ZERO)
196 IERROR = SET_U_GEO(12,MASS)
197 IERROR = SET_U_GEO(13,INER)
198 IERROR = SET_U_GEO(14,XFLG)
199 IERROR = SET_U_GEO(15,CR)
200 IERROR = SET_U_GEO(16,CR)
201 IERROR = SET_U_GEO(17,CR)
202 IERROR = SET_U_GEO(18,ZERO)
203 IERROR = SET_U_GEO(19,ZERO)
204 IERROR = SET_U_GEO(20,ZERO)
205 IERROR = SET_U_GEO(21,ZERO)
206 IERROR = SET_U_GEO(22,ZERO)
207 IERROR = SET_U_GEO(23,ZERO)
208 IERROR = SET_U_GEO(24,CRX)
209 IERROR = SET_U_GEO(25,CRY)
210 IERROR = SET_U_GEO(26,CRZ)
211 IERROR = SET_U_GEO(27,FAC_CTX)
212 IERROR = SET_U_GEO(28,FAC_CRX)
213 IERROR = SET_U_PNU(1,ZEROI,KFUNC)
214 IERROR = SET_U_PNU(2,ZEROI,KFUNC)
215 IERROR = SET_U_PNU(3,ZEROI,KFUNC)
216 IERROR = SET_U_PNU(4,IFUN_RX,KFUNC)
217 IERROR = SET_U_PNU(5,IFUN_RY,KFUNC)
218 IERROR = SET_U_PNU(6,IFUN_RZ,KFUNC)
219 IERROR = SET_U_PNU(7,ZEROI,KFUNC)
220 IERROR = SET_U_PNU(8,ZEROI,KFUNC)
221 IERROR = SET_U_PNU(9,ZEROI,KFUNC)
222 IERROR = SET_U_PNU(10,IFUN_CRX,KFUNC)
223 IERROR = SET_U_PNU(11,IFUN_CRY,KFUNC)
224 IERROR = SET_U_PNU(12,IFUN_CRZ,KFUNC)
225C-----------------------
226 WRITE(IOUT,500)
227 IF(IS_ENCRYPTED)THEN
228 WRITE(IOUT,'(5x,a,//)')'confidential data'
229 ELSE
230 IF (OFLAG==6) THEN
231 WRITE(IOUT,1001) IDSK1,IDSK2,XK,CR,KNN,KRX,KRY,KRZ,
232 . IFUN_RX,IFUN_RY,IFUN_RZ
233 ELSE
234 WRITE(IOUT,1000) IDSK1,IDSK2,XK,CR,KNN,KRX,KRY,KRZ,
235 . IFUN_RX,IFUN_RY,IFUN_RZ,CRX,CRY,CRZ,
236 . IFUN_CRX,IFUN_CRY,IFUN_CRZ
237 ENDIF
238 ENDIF
239C-----------------------
240 RETURN
241 500 FORMAT(
242 & 5X,'joint TYPE . . . . . . . . . spherical joint'//)
243 1000 FORMAT(
244 & 5X,'skew 1 frame id. . . . . . . . . . . . =',I10/,
245 & 5X,'skew 2 frame id. . . . . . . . . . . . =',I10/,
246 & 5X,'stiffness for INTERFACE k=e*a/l. . . . =',1PG20.13/,
247 & 5X,'critical damping coefficient . . . . . =',1PG20.13/,
248 & 5X,'blocking stiffness knn . . . . . . . . =',1PG20.13/,
249 & 5X,'linear rotational stiffness krx. . . . =',1PG20.13/,
250 & 5X,'linear rotational stiffness kry. . . . =',1PG20.13/,
251 & 5X,'linear rotational stiffness krz. . . . =',1PG20.13/,
252 & 5X,'user x rot function. . . . . . . . . . =',I10/,
253 & 5X,'user y rot function. . . . . . . . . . =',I10/,
254 & 5X,'user z rot function. . . . . . . . . . =',I10/,
255 & 5X,'linear damping crx . . . . . . . . . . =',1PG20.13/,
256 & 5X,'linear damping cry . . . . . . . . . . =',1PG20.13/,
257 & 5X,'linear damping crz . . . . . . . . . . =',1PG20.13/,
258 & 5X,'user rx damping FUNCTION . . . . . . . =',I10/,
259 & 5X,'user ry damping function . . . . . . . =',I10/,
260 & 5X,'user rz damping function . . . . . . . =',I10//)
261 1001 FORMAT(
262 & 5X,'skew 1 frame id. . . . . . . . . . . . =',I10/,
263 & 5X,'skew 2 frame id. . . . . . . . . . . . =',I10/,
264 & 5X,'stiffness for interface k=e*a/l. . . . =',1PG20.13/,
265 & 5X,'critical damping coefficient . . . . . =',1PG20.13/,
266 & 5X,'blocking stiffness knn . . . . . . . . =',1PG20.13/,
267 & 5X,'linear rotational stiffness krx. . . . =',1PG20.13/,
268 & 5X,'linear rotational stiffness kry. . . . =',1PG20.13/,
269 & 5X,'linear rotational stiffness krz. . . . =',1PG20.13/,
270 & 5X,'user x rot function. . . . . . . . . . =',I10/,
271 & 5X,'user y rot function. . . . . . . . . . =',I10/,
272 & 5X,'user z rot function. . . . . . . . . . =',I10//)
273 RETURN
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
id
initmumps id
Definition multiplerhs_example.m:4
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
set_u_pnu
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
set_u_geo
integer function set_u_geo(ivar, a)
Definition uaccess.F:64