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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ hm_read_prop33_old_jnt()

subroutine hm_read_prop33_old_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_old_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_CYY,IFUN_CZZ,
74 . ZEROI,OFLAG
75 my_real
76 . xk,xtyp,xflg,xsk1,xsk2,knn,kyy,kzz,cr,cyy,czz, 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---- OLDHAM 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)
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('kty',KYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
115 CALL HM_GET_FLOATV('ktz',KZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
116C--- viscosity
117C--------------------------------------------------
118C EXTRACT DATAS (INTEGER VALUES)
119C--------------------------------------------------
120 CALL HM_GET_INTV('cty_fun',IFUN_CYY,IS_AVAILABLE,LSUBMODEL)
121.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
122 CALL HM_GET_INTV('ctz_fun',IFUN_CZZ,IS_AVAILABLE,LSUBMODEL)
123.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
124C--------------------------------------------------
125C EXTRACT DATAS (REAL VALUES)
126C--------------------------------------------------
127 CALL HM_GET_FLOATV('cty',CYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
128.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
129 CALL HM_GET_FLOATV('ctz',CZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
130.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
131C-----------------------
132 IF (IDSK1<=0) THEN
133 CALL ANCMSG(MSGID=386,
134 . MSGTYPE=MSGERROR,
135 . ANMODE=ANINFO_BLIND_1,
136 . I1=ID,
137 . C1=TITR)
138 ENDIF
139 IF (KNN==0.) THEN
140 CALL ANCMSG(MSGID=387,
141 . MSGTYPE=MSGERROR,
142 . ANMODE=ANINFO_BLIND_1,
143 . I1=ID,
144 . C1=TITR)
145 ENDIF
146.OR. IF (CR<ZEROCR>1.) THEN
147 CALL ANCMSG(MSGID=388,
148 . MSGTYPE=MSGERROR,
149 . ANMODE=ANINFO_BLIND_1,
150 . I1=ID,
151 . C1=TITR)
152 ENDIF
153 IF (CR==ZERO) CR =FIVEEM2
154C
155 XTYP = ITYP
156 XFLG = SKFLAG
157 XSK1 = IDSK1
158 XSK2 = IDSK2
159 MASS = ZERO
160 INER = ZERO
161C-----------------------
162.AND. IF(CYY==ZEROIFUN_CYY/=0)CYY = ONE
163.AND. IF(CZZ==ZEROIFUN_CZZ/=0)CZZ = ONE
164.AND. IF(KYY==ZEROIFUN_YY/=0) KYY = ONE
165.AND. IF(KZZ==ZEROIFUN_ZZ/=0) KZZ = ONE
166C-----------------------
167 IF (IFUN_YY /= 0) KYY = KYY * FAC_FF
168 IF (IFUN_ZZ /= 0) KZZ = KZZ * FAC_FF
169 IF (IFUN_CYY /= 0) CYY = CYY * FAC_FF
170 IF (IFUN_CZZ /= 0) CZZ = CZZ * FAC_FF
171C-----------------------
172 PARGEO(1) = 0
173 PARGEO(2) = XK
174 PARGEO(3) = 0
175C-----------------------
176 IERROR = SET_U_GEO(1,XTYP)
177 IERROR = SET_U_GEO(2,XSK1)
178 IERROR = SET_U_GEO(3,XSK2)
179 IERROR = SET_U_GEO(4,KNN)
180 IERROR = SET_U_GEO(5,KYY)
181 IERROR = SET_U_GEO(6,KZZ)
182 IERROR = SET_U_GEO(7,KNN)
183 IERROR = SET_U_GEO(8,KNN)
184 IERROR = SET_U_GEO(9,KNN)
185 IERROR = SET_U_GEO(10,KNN)
186 IERROR = SET_U_GEO(11,ZERO)
187 IERROR = SET_U_GEO(12,MASS)
188 IERROR = SET_U_GEO(13,INER)
189 IERROR = SET_U_GEO(14,XFLG)
190 IERROR = SET_U_GEO(15,CR)
191 IERROR = SET_U_GEO(16,ZERO)
192 IERROR = SET_U_GEO(17,ZERO)
193 IERROR = SET_U_GEO(18,CR)
194 IERROR = SET_U_GEO(19,CR)
195 IERROR = SET_U_GEO(20,CR)
196 IERROR = SET_U_GEO(21,ZERO)
197 IERROR = SET_U_GEO(22,CYY)
198 IERROR = SET_U_GEO(23,CZZ)
199 IERROR = SET_U_GEO(24,ZERO)
200 IERROR = SET_U_GEO(25,ZERO)
201 IERROR = SET_U_GEO(26,ZERO)
202 IERROR = SET_U_GEO(27,FAC_CTX)
203 IERROR = SET_U_GEO(28,FAC_CRX)
204 IERROR = SET_U_PNU(1,ZEROI,KFUNC)
205 IERROR = SET_U_PNU(2,IFUN_YY,KFUNC)
206 IERROR = SET_U_PNU(3,IFUN_ZZ,KFUNC)
207 IERROR = SET_U_PNU(4,ZEROI,KFUNC)
208 IERROR = SET_U_PNU(5,ZEROI,KFUNC)
209 IERROR = SET_U_PNU(6,ZEROI,KFUNC)
210 IERROR = SET_U_PNU(7,ZEROI,KFUNC)
211 IERROR = SET_U_PNU(8,IFUN_CYY,KFUNC)
212 IERROR = SET_U_PNU(9,IFUN_CZZ,KFUNC)
213 IERROR = SET_U_PNU(10,ZEROI,KFUNC)
214 IERROR = SET_U_PNU(11,ZEROI,KFUNC)
215 IERROR = SET_U_PNU(12,ZEROI,KFUNC)
216C-----------------------
217 WRITE(IOUT,500)
218 IF(IS_ENCRYPTED)THEN
219 WRITE(IOUT,'(5x,a,//)')'confidential data'
220 ELSE
221 IF (OFLAG==4) THEN
222 WRITE(IOUT,1001)IDSK1,IDSK2,XK,CR,KNN,KYY,KZZ,IFUN_YY,IFUN_ZZ
223 ELSE
224 WRITE(IOUT,1000)IDSK1,IDSK2,XK,CR,KNN,KYY,KZZ,IFUN_YY,IFUN_ZZ,
225 . CYY,CZZ,IFUN_CYY,IFUN_CZZ
226 ENDIF
227 ENDIF
228C-----------------------
229 RETURN
230 500 FORMAT(
231 & 5X,'joint TYPE . . . . . . . . . . oldham 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 translational stiffness kyy . . =',1PG20.13/,
239 & 5X,'linear translational stiffness kzz . . =',1PG20.13/,
240 & 5X,'user y translation function. . . . . . =',I10/,
241 & 5X,'user z translation function. . . . . . =',I10/,
242 & 5X,'linear damping cyy . . . . . . . . . . =',1PG20.13/,
243 & 5X,'linear damping czz . . . . . . . . . . =',1PG20.13/,
244 & 5X,'user yy damping FUNCTION . . . . . . . =',I10/,
245 & 5X,'user zz 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 translational stiffness kyy . . =',1PG20.13/,
253 & 5X,'linear translational stiffness kzz . . =',1PG20.13/,
254 & 5X,'user y translation function. . . . . . =',I10/,
255 & 5X,'user z translation function. . . . . . =',I10//)
256 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_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
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