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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ hm_read_prop33_plan_jnt()

subroutine hm_read_prop33_plan_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_plan_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_YY,IFUN_ZZ,IFUN_RX,
74 . IFUN_CYY,IFUN_CZZ,IFUN_CRX, ZEROI,OFLAG
75 my_real
76 . xk,xtyp,xflg,xsk1,xsk2,knn,kyy,kzz,krx,cr,cyy,czz,crx,mass,iner,
77 . fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,fac_ctx,fac_crx,
78 . fac_ff,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---- PLANAR 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('Yt_fun',ifun_yy,is_available,lsubmodel)
107 CALL hm_get_intv('Zt_fun',ifun_zz,is_available,lsubmodel)
108 CALL hm_get_intv('Xr_fun',ifun_rx,is_available,lsubmodel)
109C--------------------------------------------------
110C EXTRACT DATAS (REAL VALUES)
111C--------------------------------------------------
112 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('Cr',cr,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv('Kn',knn,is_available,lsubmodel,unitab)
115 CALL hm_get_floatv('Kty',kyy,is_available,lsubmodel,unitab)
116 CALL hm_get_floatv('Ktz',kzz,is_available,lsubmodel,unitab)
117 CALL hm_get_floatv('Krx',krx,is_available,lsubmodel,unitab)
118C--- viscosity
119C--------------------------------------------------
120C EXTRACT DATAS (INTEGER VALUES)
121C--------------------------------------------------
122 CALL hm_get_intv('Cty_Fun',ifun_cyy,is_available,lsubmodel)
123 IF(.NOT.is_available) oflag = oflag + 1
124 CALL hm_get_intv('Ctz_Fun',ifun_czz,is_available,lsubmodel)
125 IF(.NOT.is_available) oflag = oflag + 1
126 CALL hm_get_intv('Crx_Fun',ifun_crx,is_available,lsubmodel)
127 IF(.NOT.is_available) oflag = oflag + 1
128C--------------------------------------------------
129C EXTRACT DATAS (REAL VALUES)
130C--------------------------------------------------
131 CALL hm_get_floatv('Cty',cyy,is_available,lsubmodel,unitab)
132 IF(.NOT.is_available) oflag = oflag + 1
133 CALL hm_get_floatv('Ctz',czz,is_available,lsubmodel,unitab)
134 IF(.NOT.is_available) oflag = oflag + 1
135 CALL hm_get_floatv('Crx',crx,is_available,lsubmodel,unitab)
136 IF(.NOT.is_available) oflag = oflag + 1
137C-----------------------
138 IF (idsk1<=0.OR.idsk1<=0) THEN
139 CALL ancmsg(msgid=386,
140 . msgtype=msgerror,
141 . anmode=aninfo_blind_1,
142 . i1=id,
143 . c1=titr)
144 ENDIF
145 IF (knn==0.) THEN
146 CALL ancmsg(msgid=387,
147 . msgtype=msgerror,
148 . anmode=aninfo_blind_1,
149 . i1=id,
150 . c1=titr)
151 ENDIF
152 IF (cr<zero.OR.cr>1.) THEN
153 CALL ancmsg(msgid=388,
154 . msgtype=msgerror,
155 . anmode=aninfo_blind_1,
156 . i1=id,
157 . c1=titr)
158 ENDIF
159 IF (cr==zero) cr = fiveem2
160C
161 xtyp = ityp
162 xflg = skflag
163 xsk1 = idsk1
164 xsk2 = idsk2
165 mass = zero
166 iner = zero
167C
168 IF(kyy==zero.AND.ifun_yy/=0) kyy = one
169 IF(kzz==zero.AND.ifun_zz/=0) kzz = one
170 IF(krx==zero.AND.ifun_rx/=0) krx = one
171 IF(cyy==zero.AND.ifun_cyy/=0)cyy = one
172 IF(czz==zero.AND.ifun_czz/=0)czz = one
173 IF(crx==zero.AND.ifun_crx/=0)crx = one
174C-----------------------
175 IF (ifun_yy /= 0) kyy = kyy * fac_ff
176 IF (ifun_zz /= 0) kzz = kzz * fac_ff
177 IF (ifun_rx /= 0) krx = krx * fac_mm
178 IF (ifun_cyy /= 0) cyy = cyy * fac_ff
179 IF (ifun_czz /= 0) czz = czz * fac_ff
180 IF (ifun_crx /= 0) crx = crx * fac_mm
181C-----------------------
182 pargeo(1) = 0
183 pargeo(2) = xk
184 pargeo(3) = 0
185C-----------------------
186 ierror = set_u_geo(1,xtyp)
187 ierror = set_u_geo(2,xsk1)
188 ierror = set_u_geo(3,xsk2)
189 ierror = set_u_geo(4,knn)
190 ierror = set_u_geo(5,kyy)
191 ierror = set_u_geo(6,kzz)
192 ierror = set_u_geo(7,krx)
193 ierror = set_u_geo(8,knn)
194 ierror = set_u_geo(9,knn)
195 ierror = set_u_geo(10,knn)
196 ierror = set_u_geo(11,zero)
197 ierror = set_u_geo(12,mass)
198 ierror = set_u_geo(13,iner)
199 ierror = set_u_geo(14,xflg)
200 ierror = set_u_geo(15,cr)
201 ierror = set_u_geo(16,zero)
202 ierror = set_u_geo(17,zero)
203 ierror = set_u_geo(18,zero)
204 ierror = set_u_geo(19,cr)
205 ierror = set_u_geo(20,cr)
206 ierror = set_u_geo(21,zero)
207 ierror = set_u_geo(22,cyy)
208 ierror = set_u_geo(23,czz)
209 ierror = set_u_geo(24,crx)
210 ierror = set_u_geo(25,zero)
211 ierror = set_u_geo(26,zero)
212 ierror = set_u_geo(27,fac_ctx)
213 ierror = set_u_geo(28,fac_crx)
214 ierror = set_u_pnu(1,zeroi,kfunc)
215 ierror = set_u_pnu(2,ifun_yy,kfunc)
216 ierror = set_u_pnu(3,ifun_zz,kfunc)
217 ierror = set_u_pnu(4,ifun_rx,kfunc)
218 ierror = set_u_pnu(5,zeroi,kfunc)
219 ierror = set_u_pnu(6,zeroi,kfunc)
220 ierror = set_u_pnu(7,zeroi,kfunc)
221 ierror = set_u_pnu(8,ifun_cyy,kfunc)
222 ierror = set_u_pnu(9,ifun_czz,kfunc)
223 ierror = set_u_pnu(10,ifun_crx,kfunc)
224 ierror = set_u_pnu(11,zeroi,kfunc)
225 ierror = set_u_pnu(12,zeroi,kfunc)
226C-----------------------
227 WRITE(iout,500)
228 IF(is_encrypted)THEN
229 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
230 ELSE
231 IF (oflag==6) THEN
232 WRITE(iout,1001) idsk1,idsk2,xk,cr,knn,kyy,kzz,krx,
233 . ifun_yy,ifun_zz,ifun_rx
234 ELSE
235 WRITE(iout,1000) idsk1,idsk2,xk,cr,knn,kyy,kzz,krx,
236 . ifun_yy,ifun_zz,ifun_rx,
237 . cyy,czz,crx,ifun_cyy,ifun_czz,ifun_crx
238 ENDIF
239 ENDIF
240C-----------------------
241 RETURN
242 500 FORMAT(
243 & 5x,'JOINT TYPE . . . . . . . . . . PLANAR JOINT'//)
244 1000 FORMAT(
245 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
246 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
247 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
248 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
249 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
250 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KYY . . =',1pg20.13/,
251 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KZZ . . =',1pg20.13/,
252 & 5x,'LINEAR TORSION STIFFNESS KRX . . . . . =',1pg20.13/,
253 & 5x,'USER Y TRANSLATION FUNCTION. . . . . . =',i10/,
254 & 5x,'USER Z TRANSLATION FUNCTION. . . . . . =',i10/,
255 & 5x,'USER RX TORSION FUNCTION ID. . . . . . =',i10/,
256 & 5x,'linear damping cyy . . . . . . . . . . =',1PG20.13/,
257 & 5X,'linear damping czz . . . . . . . . . . =',1PG20.13/,
258 & 5X,'linear damping crx . . . . . . . . . . =',1PG20.13/,
259 & 5X,'user yy damping FUNCTION . . . . . . . =',I10/,
260 & 5X,'user zz damping function . . . . . . . =',I10/,
261 & 5X,'user rx damping function . . . . . . . =',I10//)
262 1001 FORMAT(
263 & 5X,'skew 1 frame id. . . . . . . . . . . . =',I10/,
264 & 5X,'skew 2 frame id. . . . . . . . . . . . =',I10/,
265 & 5X,'stiffness for interface k=e*a/l. . . . =',1PG20.13/,
266 & 5X,'critical damping coefficient . . . . . =',1PG20.13/,
267 & 5X,'blocking stiffness knn . . . . . . . . =',1PG20.13/,
268 & 5X,'linear translational stiffness kyy . . =',1PG20.13/,
269 & 5X,'linear translational stiffness kzz . . =',1PG20.13/,
270 & 5X,'linear torsion stiffness krx . . . . . =',1PG20.13/,
271 & 5X,'user y translation function. . . . . . =',I10/,
272 & 5X,'user z translation function. . . . . . =',I10/,
273 & 5X,'user rx torsion function id. . . . . . =',I10//)
274 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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
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: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
set_u_geo
integer function set_u_geo(ivar, a)
Definition uaccess.F:64