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
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_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 IF(.NOT.is_available) oflag = oflag + 1
118C--------------------------------------------------
119C EXTRACT DATAS (REAL VALUES)
120C--------------------------------------------------
121 CALL hm_get_floatv('Crx',crx,is_available,lsubmodel,unitab)
122 IF(.NOT.is_available) oflag = oflag + 1
123C-----------------------
124 IF (idsk1<=0.OR.idsk1<=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 IF (cr<zero.OR.cr>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 IF(crx==zero.AND.ifun_crx/=0)crx = one
155 IF(krx==zero.AND.ifun_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
my_real
#define my_real
Definition cppsort.cpp:32
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
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