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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ hm_read_prop33_rev_jnt()

subroutine hm_read_prop33_rev_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_rev_jnt.F.

39 USE unitab_mod
40 USE message_mod
41 USE submodel_mod
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_CRX,ZEROI,OFLAG
74 my_real
75 . xk,xtyp,xflg,xsk1,xsk2,knn,krx,cr,crx,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---- REVOLUTE 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('Xr_fun',ifun_rx,is_available,lsubmodel)
105C--------------------------------------------------
106C EXTRACT DATAS (REAL VALUES)
107C--------------------------------------------------
108 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv('Cr',cr,is_available,lsubmodel,unitab)
110 CALL hm_get_floatv('Kn',knn,is_available,lsubmodel,unitab)
111 CALL hm_get_floatv('krx',KRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
112C--- viscosity
113C--------------------------------------------------
114C EXTRACT DATAS (INTEGER VALUES)
115C--------------------------------------------------
116 CALL HM_GET_INTV('crx_fun',IFUN_CRX,IS_AVAILABLE,LSUBMODEL)
117.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
118C--------------------------------------------------
119C EXTRACT DATAS (REAL VALUES)
120C--------------------------------------------------
121 CALL HM_GET_FLOATV('crx',CRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
122.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
123C-----------------------
124.OR. IF (IDSK1<=0IDSK1<=0) THEN
125 CALL ANCMSG(MSGID=386,
126 . MSGTYPE=MSGERROR,
127 . ANMODE=ANINFO_BLIND_1,
128 . I1=ID,
129 . C1=TITR)
130 ENDIF
131 IF (KNN==0.) THEN
132 CALL ANCMSG(MSGID=387,
133 . MSGTYPE=MSGERROR,
134 . ANMODE=ANINFO_BLIND_1,
135 . I1=ID,
136 . C1=TITR)
137 ENDIF
138.OR. IF (CR<ZEROCR>1.) THEN
139 CALL ANCMSG(MSGID=388,
140 . MSGTYPE=MSGERROR,
141 . ANMODE=ANINFO_BLIND_1,
142 . I1=ID,
143 . C1=TITR)
144 ENDIF
145 IF (CR==ZERO) CR = FIVEEM2
146C
147 XTYP = ITYP
148 XFLG = SKFLAG
149 XSK1 = IDSK1
150 XSK2 = IDSK2
151 MASS = ZERO
152 INER = ZERO
153C
154.AND. IF(CRX==ZEROIFUN_CRX/=0)CRX = ONE
155.AND. IF(KRX==ZEROIFUN_RX/=0) KRX = ONE
156C
157C-----------------------
158 IF (IFUN_RX /= 0) KRX = KRX * FAC_MM
159 IF (IFUN_CRX /= 0) CRX = CRX * FAC_MM
160C-----------------------
161 PARGEO(1) = 0
162 PARGEO(2) = XK
163 PARGEO(3) = 0
164C-----------------------
165 IERROR = SET_U_GEO(1,XTYP)
166 IERROR = SET_U_GEO(2,XSK1)
167 IERROR = SET_U_GEO(3,XSK2)
168 IERROR = SET_U_GEO(4,KNN)
169 IERROR = SET_U_GEO(5,KNN)
170 IERROR = SET_U_GEO(6,KNN)
171 IERROR = SET_U_GEO(7,KRX)
172 IERROR = SET_U_GEO(8,KNN)
173 IERROR = SET_U_GEO(9,KNN)
174 IERROR = SET_U_GEO(10,KNN)
175 IERROR = SET_U_GEO(11,ZERO)
176 IERROR = SET_U_GEO(12,MASS)
177 IERROR = SET_U_GEO(13,INER)
178 IERROR = SET_U_GEO(14,XFLG)
179 IERROR = SET_U_GEO(15,CR)
180 IERROR = SET_U_GEO(16,CR)
181 IERROR = SET_U_GEO(17,CR)
182 IERROR = SET_U_GEO(18,ZERO)
183 IERROR = SET_U_GEO(19,CR)
184 IERROR = SET_U_GEO(20,CR)
185 IERROR = SET_U_GEO(21,ZERO)
186 IERROR = SET_U_GEO(22,ZERO)
187 IERROR = SET_U_GEO(23,ZERO)
188 IERROR = SET_U_GEO(24,CRX)
189 IERROR = SET_U_GEO(25,ZERO)
190 IERROR = SET_U_GEO(26,ZERO)
191 IERROR = SET_U_GEO(27,FAC_CTX)
192 IERROR = SET_U_GEO(28,FAC_CRX)
193 IERROR = SET_U_PNU(1,ZEROI,KFUNC)
194 IERROR = SET_U_PNU(2,ZEROI,KFUNC)
195 IERROR = SET_U_PNU(3,ZEROI,KFUNC)
196 IERROR = SET_U_PNU(4,IFUN_RX,KFUNC)
197 IERROR = SET_U_PNU(5,ZEROI,KFUNC)
198 IERROR = SET_U_PNU(6,ZEROI,KFUNC)
199 IERROR = SET_U_PNU(7,ZEROI,KFUNC)
200 IERROR = SET_U_PNU(8,ZEROI,KFUNC)
201 IERROR = SET_U_PNU(9,ZEROI,KFUNC)
202 IERROR = SET_U_PNU(10,IFUN_CRX,KFUNC)
203 IERROR = SET_U_PNU(11,ZEROI,KFUNC)
204 IERROR = SET_U_PNU(12,ZEROI,KFUNC)
205C-----------------------
206 WRITE(IOUT,500)
207 IF(IS_ENCRYPTED)THEN
208 WRITE(IOUT,'(5x,a,//)')'CONFIDENTIAL DATA'
209 ELSE
210 IF (oflag==2) THEN
211 WRITE(iout,1001)idsk1,idsk2,xk,cr,knn,krx,ifun_rx
212 ELSE
213 WRITE(iout,1000)idsk1,idsk2,xk,cr,knn,krx,ifun_rx,crx,ifun_crx
214 ENDIF
215 ENDIF
216C-----------------------
217 RETURN
218 500 FORMAT(
219 & 5x,'JOINT TYPE . . . . . . . . REVOLUTE JOINT'//)
220 1000 FORMAT(
221 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
222 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
223 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
224 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
225 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
226 & 5x,'LINEAR ROTATIONAL STIFFNESS KRX. . . . =',1pg20.13/,
227 & 5x,'ROTATIONAL FUNCTION ID. . . . . . . . .=',i10/,
228 & 5x,'LINEAR DAMPING CRX . . . . . . . . . . =',1pg20.13/,
229 & 5x,'USER RX DAMPING FUNCTION . . . . . . . =',i10//)
230 1001 FORMAT(
231 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
232 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
233 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
234 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
235 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
236 & 5x,'LINEAR ROTATIONAL STIFFNESS KRX. . . . =',1pg20.13/,
237 & 5x,'ROTATIONAL FUNCTION ID. . . . . . . . .=',i10//)
238 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer, parameter nchartitle
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
integer function set_u_geo(ivar, a)
Definition uaccess.F:64